source: trunk/lib/Epoll/DB/ImportV/Ldap.pm @ 347

package Epoll::DB::ImportV::Ldap;

use strict;
use warnings;
use base qw(Epoll::DB::ImportV);
use Net::LDAP;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED );

sub _unlimited_search {
    my $ldap = shift;
    my @args = @_;

    my ($page, $cookie) = (Net::LDAP::Control::Paged->new( size => 100 ));

    while (1) {
        my $search = $ldap->search(
            @args,
            control => [ $page ],
        );
        if ($search->code) {
            return $search;
        }

        ### After foreach loops ends, client checks LDAP server reponse of how many search results total.
        ### This is a control to end the infinite while loop if there are no search results to go through 
        ### If there are search results, this control will always return the total number of results. It is
        ### never decremented
        my ($resp) = $search->control( LDAP_CONTROL_PAGED ) or last;


        ### Obtaining the cookie from the search result. When no more results, cookie will be NULL
        ### and infinite while loop will terminate.
        $cookie = $resp->cookie or last;

        ### Sets cookie so server knows the next search result to send 
        $page->cookie($cookie);
    }
    ### This is a control to check for abnormal exit of the while loop.
    ### If this occurs ### we need to tell the LDAP server that remaining
    ### search results are no longer needed ### by sending a search request with a page size of 0
    if ($cookie)    {
        $page->cookie($cookie);
        $page->size(0);
        $ldap->search(@args, control => [ $page ]);
    }
    return 1;
}

sub fetch_voters {
    my ($self) = @_;
    $self->{params}{uri} or return;
    my $ldap = Net::LDAP->new($self->{params}{uri}) or return;

    {
        my $msg = $ldap->bind($self->{params}{login},
            ($self->{params}{login}
              ? (password => $self->{params}{password})
              : ()),
        );

        $msg->code and do {
            warn $msg->error;
            return;
        };
    }

    my @list;
    _unlimited_search(
        $ldap,
        base => $self->{params}{basedn},
        scope => 'sub',
        filter => $self->{params}{filter},
        attrs => [ grep { $_ } map { $self->{params}{$_} } qw(mail uid displayname) ],
        callback => sub {
            my ($mesg, $entry) = @_;
            $entry or return;
            my @voters = map {
                $self->{params}{$_}
                ? ($self->{params}{$_} eq 'dn'
                    ? $entry->dn
                    : $entry->get_value($self->{params}{$_}) || undef)
                : undef
            } qw(mail displayname uid);
            $voters[0] or return;

            push(@list, \@voters);
        },
    );

    @list
}

sub authenticate {
    my ($self, $mail, $uid, $passwd) = @_;
    my $ldap = Net::LDAP->new($self->{params}{uri}) or return;

    my $msg = $ldap->bind($uid, password => $passwd);
    $msg->code and return;
    return 1;
}

1;