[Catalyst-commits] r7432 - in
Catalyst-Authentication-Store-LDAP/trunk: .
lib/Catalyst/Authentication/Store
lib/Catalyst/Authentication/Store/LDAP t
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Tue Feb 5 18:16:33 GMT 2008
Author: karpet
Date: 2008-02-05 18:16:32 +0000 (Tue, 05 Feb 2008)
New Revision: 7432
Removed:
Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl
Modified:
Catalyst-Authentication-Store-LDAP/trunk/Changes
Catalyst-Authentication-Store-LDAP/trunk/MANIFEST
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
Log:
0.1000 release
Modified: Catalyst-Authentication-Store-LDAP/trunk/Changes
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/Changes 2008-02-05 15:20:42 UTC (rev 7431)
+++ Catalyst-Authentication-Store-LDAP/trunk/Changes 2008-02-05 18:16:32 UTC (rev 7432)
@@ -5,6 +5,10 @@
- changed release date for 0.0600
- added AD config suggestions from matija at serverflow.com
- bumped req base Auth package to 0.10003
+ - lookup_user() now throws an exception if there is more than one entry returned
+ from a LDAP search
+ - added new user_search_filter config option to filter out multiple entries on
+ Perl side
0.0600 karman 18 Oct 2007 [was: omega Thu Aug 09 09:22:00 CET 2007]
Modified: Catalyst-Authentication-Store-LDAP/trunk/MANIFEST
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/MANIFEST 2008-02-05 15:20:42 UTC (rev 7431)
+++ Catalyst-Authentication-Store-LDAP/trunk/MANIFEST 2008-02-05 18:16:32 UTC (rev 7432)
@@ -13,7 +13,6 @@
lib/Catalyst/Authentication/Store/LDAP.pm
lib/Catalyst/Authentication/Store/LDAP/Backend.pm
lib/Catalyst/Authentication/Store/LDAP/User.pm
-Makefile.old
Makefile.PL
MANIFEST This list of files
META.yml
Modified: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm 2008-02-05 15:20:42 UTC (rev 7431)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm 2008-02-05 18:16:32 UTC (rev 7432)
@@ -36,6 +36,7 @@
'user_search_options' => {
'deref' => 'always',
},
+ 'user_results_filter' => sub { return shift->pop_entry },
'entry_class' => 'MyApp::LDAP::Entry',
'use_roles' => 1,
'role_basedn' => 'ou=groups,dc=yourcompany,dc=com',
@@ -90,6 +91,7 @@
user_attrs user_field use_roles role_basedn
role_filter role_scope role_field role_value
role_search_options start_tls start_tls_options
+ user_results_filter
)
);
}
@@ -263,7 +265,7 @@
'attributes' => $attributes,
}
-This method is usually only called by get_user.
+This method is usually only called by find_user().
=cut
@@ -295,21 +297,32 @@
"LDAP Error while searching for user: " . $usersearch->error );
}
my $userentry;
- my $user_field = $self->user_field;
- my @user_fields
- = ref $user_field eq 'ARRAY' ? @$user_field : ($user_field);
+ 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." );
+ }
- # TODO check for multiple matches, which we should really not have.
-RESULT: while ( my $entry = $usersearch->pop_entry ) {
- foreach my $field (@user_fields) {
- foreach my $value ( $entry->get_value($field) ) {
- if ( $value eq $id ) {
- $userentry = $entry;
- last RESULT;
- }
- }
+ # a little extra sanity check with the 'eq' since LDAP already
+ # says it matches.
+ if ( defined($entry) ) {
+ unless ( $entry->get_value($user_field) eq $id ) {
+ Catalyst::Exception->throw(
+ "LDAP claims '$user_field' equals '$id' but results entry does not match."
+ );
}
+ $userentry = $entry;
}
+
$ldap->unbind;
$ldap->disconnect;
unless ($userentry) {
Modified: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm 2008-02-05 15:20:42 UTC (rev 7431)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm 2008-02-05 18:16:32 UTC (rev 7432)
@@ -63,6 +63,7 @@
user_filter => "(&(objectClass=posixAccount)(uid=%s))",
user_scope => "one",
user_search_options => { deref => "always" },
+ user_results_filter => sub { return shift->pop_entry },
},
},
},
@@ -234,6 +235,27 @@
As they are already taken care of by other configuration options.
+=head2 user_results_filter
+
+This is a Perl CODE ref that can be used to filter out multiple results
+from your LDAP query. In theory, your LDAP query should only return one result
+and find_user() will throw an exception if it encounters more than one result.
+However, if you have, for whatever reason, a legitimate reason for returning
+multiple search results from your LDAP query, use C<user_results_filter> to filter
+out the LDAP entries you do not want considered. Your CODE ref should expect
+a single argument, a Net::LDAP::Search object, and it should return exactly one
+value, a Net::LDAP::Entry object.
+
+Example:
+
+ user_results_filter => sub {
+ my $search_obj = shift;
+ foreach my $entry ($search_obj->entries) {
+ return $entry if my_match_logic( $entry );
+ }
+ return undef; # i.e., no match
+ }
+
=head2 use_roles
Whether or not to enable role lookups. It defaults to true; set it to 0 if
Deleted: Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl 2008-02-05 15:20:42 UTC (rev 7431)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl 2008-02-05 18:16:32 UTC (rev 7432)
@@ -1,93 +0,0 @@
-
-use Test::More tests => 12;
-use Carp;
-use Net::LDAP;
-use Net::LDAP::Server::Test;
-use Net::LDAP::Entry;
-
-#
-# these tests pulled nearly verbatim from the Net::LDAP synopsis
-#
-
-my %opts = (
- port => '10636',
- dnc => 'ou=internal,dc=foo',
- debug => $ENV{PERL_DEBUG} || 0,
-);
-
-my $host = 'ldap://localhost:' . $opts{port};
-
-ok( my $server = Net::LDAP::Server::Test->new( $opts{port} ),
- "spawn new server" );
-
-ok( my $ldap = Net::LDAP->new( $host, %opts, ), "new LDAP connection" );
-
-unless ($ldap) {
- croak "Unable to connect to LDAP server $host: $@";
-}
-
-ok( my $rc = $ldap->bind(), "LDAP bind()" );
-
-ok( my $mesg = $ldap->search( # perform a search
- base => "c=US",
- filter => "(&(sn=Barr) (o=Texas Instruments))"
- ),
- "LDAP search()"
-);
-
-$mesg->code && croak $mesg->error;
-
-my $count = 0;
-foreach my $entry ( $mesg->entries ) {
-
- #$entry->dump;
- $count++;
-}
-
-is( $count, 13, "$count entries found in search" );
-
-ok( $mesg = $ldap->unbind, "LDAP unbind()" );
-
-#warn "unbind done";
-
-my @mydata;
-my $entry = Net::LDAP::Entry->new;
-$entry->dn('ou=foobar');
-$entry->add(
- dn => 'ou=foobar',
- sn => 'value1',
- cn => [qw(value1 value2)]
-);
-push @mydata, $entry;
-
-ok( $server = Net::LDAP::Server::Test->new( $opts{port}, \@mydata ),
- "spawn new server with our own data" );
-
-ok( $ldap = Net::LDAP->new( $host, %opts, ), "new LDAP connection" );
-
-unless ($ldap) {
- croak "Unable to connect to LDAP server $host: $@";
-}
-
-ok( $rc = $ldap->bind(), "LDAP bind()" );
-
-ok( $mesg = $ldap->search( # perform a search
- base => "c=US",
- filter => "(&(sn=Barr) (o=Texas Instruments))"
- ),
- "LDAP search()"
-);
-
-$mesg->code && croak $mesg->error;
-
-$count = 0;
-foreach my $entry ( $mesg->entries ) {
-
- $entry->dump;
- $count++;
-}
-
-is( $count, 1, "$count entries found in search" );
-
-ok( $mesg = $ldap->unbind, "LDAP unbind()" );
-
More information about the Catalyst-commits
mailing list