X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAuthentication%2FStore%2FLDAP%2FBackend.pm;h=403b63c0705bf80c877b9cf757068a55b7f63ea7;hb=5a9aba6e13855eefe942190745802604cf8b72b0;hp=b33ce82943a6ec3f1d7da72569fd2ac4a462514f;hpb=06ceeedec197bb745399ff42f4213179ecd26839;p=catagits%2FCatalyst-Authentication-Store-LDAP.git

diff --git a/lib/Catalyst/Authentication/Store/LDAP/Backend.pm b/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
index b33ce82..403b63c 100644
--- a/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
+++ b/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
@@ -31,7 +31,7 @@ Catalyst::Authentication::Store::LDAP::Backend
             },
             'user_basedn' => 'ou=people,dc=yourcompany,dc=com',
             'user_filter' => '(&(objectClass=posixAccount)(uid=%s))',
-            'user_scope' => 'one',
+            'user_scope' => 'one',  # or 'sub' for Active Directory
             'user_field' => 'uid',
             'user_search_options' => {
                 'deref' => 'always',
@@ -72,7 +72,7 @@ use base qw( Class::Accessor::Fast );
 use strict;
 use warnings;
 
-our $VERSION = '0.1005';
+our $VERSION = '1.014';
 
 use Catalyst::Authentication::Store::LDAP::User;
 use Net::LDAP;
@@ -120,10 +120,11 @@ sub new {
     $config_hash{'use_roles'}   ||= '1';
     $config_hash{'start_tls'}   ||= '0';
     $config_hash{'entry_class'} ||= 'Catalyst::Model::LDAP::Entry';
-    $config_hash{'user_class'}  ||= 'Catalyst::Authentication::Store::LDAP::User';
+    $config_hash{'user_class'}
+        ||= 'Catalyst::Authentication::Store::LDAP::User';
     $config_hash{'role_search_as_user'} ||= 0;
 
-    Catalyst::Utils::ensure_class_loaded($config_hash{'user_class'});
+    Catalyst::Utils::ensure_class_loaded( $config_hash{'user_class'} );
     my $self = \%config_hash;
     bless( $self, $class );
     return $self;
@@ -145,7 +146,7 @@ sub find_user {
     return $self->get_user( $authinfo->{id} || $authinfo->{username}, $c );
 }
 
-=head2 get_user($id)
+=head2 get_user( I<id>, $c)
 
 Creates a L<Catalyst::Authentication::Store::LDAP::User> object
 for the given User ID, or calls C<new> on the class specified in
@@ -157,8 +158,7 @@ This is the preferred mechanism for getting a given User out of the Store.
 
 sub get_user {
     my ( $self, $id, $c ) = @_;
-    my $user = $self->user_class->new( $self,
-        $self->lookup_user($id), $c );
+    my $user = $self->user_class->new( $self, $self->lookup_user($id), $c );
     return $user;
 }
 
@@ -210,17 +210,24 @@ If $binddn is "anonymous", an anonymous bind will be performed.
 sub ldap_bind {
     my ( $self, $ldap, $binddn, $bindpw, $forauth ) = @_;
     $forauth ||= 0;
-    $ldap    ||= $self->ldap_connect;
+    $ldap ||= $self->ldap_connect;
     if ( !defined($ldap) ) {
         Catalyst::Exception->throw("LDAP Server undefined!");
     }
-    $binddn ||= $self->binddn;
-    $bindpw ||= $self->bindpw;
+
+    # if username is present, make sure password is present too.
+    # see https://rt.cpan.org/Ticket/Display.html?id=81908
+    if ( !defined $binddn ) {
+        $binddn = $self->binddn;
+        $bindpw = $self->bindpw;
+    }
+
     if ( $binddn eq "anonymous" ) {
         $self->_ldap_bind_anon($ldap);
     }
     else {
-        if ($bindpw) {
+        # Don't fall back to unauthenticated bind when authenticating
+        if ($bindpw or $forauth eq 'forauth') {
             my $mesg = $ldap->bind( $binddn, 'password' => $bindpw );
             if ( $mesg->is_error ) {
 
@@ -236,14 +243,14 @@ sub ldap_bind {
             }
         }
         else {
-            $self->_ldap_bind_anon($ldap, $binddn);
+            $self->_ldap_bind_anon( $ldap, $binddn );
         }
     }
     return $ldap;
 }
 
 sub _ldap_bind_anon {
-    my ($self, $ldap, $dn) = @_;
+    my ( $self, $ldap, $dn ) = @_;
     my $mesg = $ldap->bind($dn);
     if ( $mesg->is_error ) {
         Catalyst::Exception->throw( "Error on Bind: " . $mesg->error );
@@ -275,10 +282,6 @@ This method is usually only called by find_user().
 sub lookup_user {
     my ( $self, $id ) = @_;
 
-    # No sneaking in wildcards!
-    if ( $id =~ /\*/ ) {
-        Catalyst::Exception->throw("ID $id contains wildcards!");
-    }
     # Trim trailing space or we confuse ourselves
     $id =~ s/\s+$//;
     my $ldap = $self->ldap_bind;
@@ -298,7 +301,7 @@ sub lookup_user {
     }
     my $usersearch = $ldap->search(@searchopts);
 
-    return if ( $usersearch->is_error );
+    return undef if ( $usersearch->is_error );
 
     my $userentry;
     my $user_field     = $self->user_field;
@@ -345,8 +348,8 @@ sub lookup_user {
             $attrhash->{ lc($attr) } = \@attrvalues;
         }
     }
-    
-    eval { Catalyst::Utils::ensure_class_loaded($self->entry_class) };
+
+    eval { Catalyst::Utils::ensure_class_loaded( $self->entry_class ) };
     if ( !$@ ) {
         bless( $userentry, $self->entry_class );
         $userentry->{_use_unicode}++;
@@ -375,7 +378,8 @@ sub lookup_roles {
     if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) {
         return undef;
     }
-    $ldap ||= $self->ldap_bind;
+    $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 );
@@ -411,6 +415,7 @@ sub _replace_filter {
     my $self    = shift;
     my $filter  = shift;
     my $replace = shift;
+    $replace =~ s/([*()\\\x{0}])/sprintf '\\%02x', ord($1)/ge;
     $filter =~ s/\%s/$replace/g;
     return $filter;
 }
@@ -429,7 +434,7 @@ sub user_supports {
     Catalyst::Authentication::Store::LDAP::User->supports(@_);
 }
 
-=head2 from_session( I<id> )
+=head2 from_session( I<id>, I<$c> )
 
 Returns get_user() for I<id>.
 
@@ -437,7 +442,7 @@ Returns get_user() for I<id>.
 
 sub from_session {
     my ( $self, $c, $id ) = @_;
-    $self->get_user($id);
+    $self->get_user( $id, $c );
 }
 
 1;