view release on metacpan or  search on metacpan

AuthTicketLDAP.pm  view on Meta::CPAN

    return $_ldap_handle;
}

sub ldap_search {
    my ($self, $user) = @_;
    my ($ldapdn,$ldapscope,$ldapfilter,$ldf,$ldap,$search,$entry,
    $mesg);

    $ldapdn = $self->get_config('LDAPDN');
    $ldapscope = $self->get_config('LDAPScope');
    $ldapfilter = $self->get_config('LDAPFilter');

    $ldf = $ldapfilter;
    $ldf =~ s/MYUSER/$user/g;

    $search = $self->ldap->search(
      base => $ldapdn,
      scope => $ldapscope,
      filter => $ldf
    ) or die "$@"; 

    if ($search->count() <= 0) {
        return undef;
    }

    $entry = $search->pop_entry();
    return $entry;
}

#FIXME CHI documentation suggests we may need to 
# forcibly remove aged cache entries
sub ldap_cache {
    my ($self, $user, $entry) = @_;
    my $auth_name = $self->request->auth_name;

    if (!$user || !$auth_name) {
        return undef;
    }

    my $cache_user = $auth_name . $CACHE_ENTRY_DELIMITER . $user;

    # Store and return LDAP entry
    if ($user && $entry) {
        return $_ldap_entry_cache->set($cache_user, $entry);
    } 
    
    # Retrieve
    my $cached_entry = $_ldap_entry_cache->get($cache_user);
    if ($cached_entry) {
	return $cached_entry;
    }

    $entry = $self->ldap_search($user);
    if ($entry) {
        return $self->ldap_cache($user, $entry);
    }

    return undef;
}

sub check_credentials {
    my ($self, $user, $password) = @_;
    my ($entry, $mesg);
    # 1) check_ldap_cache for UID entry. Avoids anonymous search.
    # 2) if not in cache, run a search and cache the result
    # 3) lastly, bind with supplied password.

    $entry = $self->ldap_cache($user) or return 0;

    $mesg = $self->ldap->bind($entry->dn(), password => $password)
        or die "$@";

    if (!$mesg->is_error()) {
        return 1;
    }

    return 0;
}

sub ldap_attribute {
    my ($class, $r, $args) = @_;
    my ($attr, $val) = split(/=/, $args, 2);
    my ($self, $user, $entry);

    $self = $class->new($r);
    $user = $r->user;
    $entry = $self->ldap_cache($user) or return HTTP_FORBIDDEN;

    for my $a ($entry->get_value($attr)) {
        if ($a eq $val) {
            return OK;
        }
    }

    return HTTP_FORBIDDEN;
}

sub stmt_cache_set {
    my ($self, $cache_stmt, $row) = @_;

    if (!$row && !$cache_stmt) {
        return undef;
    }

    # Store and return stmt result
    return $_stmt_cache->set($cache_stmt, $row);
}

sub stmt_cache {
    my ($self, $stmt, @bind) = @_;

    if (!$stmt) {
        return undef;
    }

    my $cache_stmt = join($CACHE_ENTRY_DELIMITER, $stmt, @bind);

    # Retrieve
    my $cached_entry = $_stmt_cache->get($cache_stmt);
    if ($cached_entry) {
	return $cached_entry;