X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAuthentication%2FStore%2FLDAP%2FBackend.pm;h=a0be77a8212078e37df7b3f7d6f973a86cb97526;hb=4d784742b52f19a6975c4c3b72c51134e7725f8e;hp=b8977040f4b18588048c78a60b28c3ab499d594b;hpb=ab62b426562470d4ffc97953ad15a3f5fca88008;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 b897704..a0be77a 100644
--- a/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
+++ b/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
@@ -31,13 +31,14 @@ 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',
             },
             'user_results_filter' => sub { return shift->pop_entry },
             'entry_class' => 'MyApp::LDAP::Entry',
+            'user_class' => 'MyUser',
             'use_roles' => 1,
             'role_basedn' => 'ou=groups,dc=yourcompany,dc=com',
             'role_filter' => '(&(objectClass=posixGroup)(member=%s))',
@@ -47,23 +48,16 @@ Catalyst::Authentication::Store::LDAP::Backend
             'role_search_options' => {
                 'deref' => 'always',
             },
+            'role_search_as_user' => 0,
     );
     
     our $users = Catalyst::Authentication::Store::LDAP::Backend->new(\%config);
 
-    sub action : Local {
-        my ( $self, $c ) = @_;
-
-        $c->login( $users->get_user( $c->req->param("login") ),
-            $c->req->param("password") );
-    }
-
 =head1 DESCRIPTION
 
-You probably want L<Catalyst::Authentication::Store::LDAP>, unless
-you are mixing several stores in a single app and one of them is LDAP.
+You probably want L<Catalyst::Authentication::Store::LDAP>.
 
-Otherwise, this lets you create a store manually. 
+Otherwise, this lets you create a store manually.
 
 See the L<Catalyst::Authentication::Store::LDAP> documentation for
 an explanation of the configuration options.
@@ -78,10 +72,11 @@ use base qw( Class::Accessor::Fast );
 use strict;
 use warnings;
 
-our $VERSION = '0.1002';
+our $VERSION = '1.013';
 
 use Catalyst::Authentication::Store::LDAP::User;
 use Net::LDAP;
+use Catalyst::Utils ();
 
 BEGIN {
     __PACKAGE__->mk_accessors(
@@ -91,7 +86,7 @@ BEGIN {
             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
+            user_results_filter user_class role_search_as_user
             )
     );
 }
@@ -125,13 +120,17 @@ 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{'role_search_as_user'} ||= 0;
 
+    Catalyst::Utils::ensure_class_loaded( $config_hash{'user_class'} );
     my $self = \%config_hash;
     bless( $self, $class );
     return $self;
 }
 
-=head2 find_user( I<authinfo> )
+=head2 find_user( I<authinfo>, $c )
 
 Creates a L<Catalyst::Authentication::Store::LDAP::User> object
 for the given User ID.  This is the preferred mechanism for getting a 
@@ -144,21 +143,22 @@ C<username>. The value will be compared against the LDAP C<user_field> field.
 
 sub find_user {
     my ( $self, $authinfo, $c ) = @_;
-    return $self->get_user( $authinfo->{id} || $authinfo->{username} );
+    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.  This is the preferred mechanism for getting a 
-given User out of the Store.
+for the given User ID, or calls C<new> on the class specified in
+C<user_class>.  This instance of the store object, the results of
+C<lookup_user> and $c are passed as arguments (in that order) to C<new>.
+This is the preferred mechanism for getting a given User out of the Store.
 
 =cut
 
 sub get_user {
-    my ( $self, $id ) = @_;
-    my $user = Catalyst::Authentication::Store::LDAP::User->new( $self,
-        $self->lookup_user($id) );
+    my ( $self, $id, $c ) = @_;
+    my $user = $self->user_class->new( $self, $self->lookup_user($id), $c );
     return $user;
 }
 
@@ -210,17 +210,20 @@ 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" ) {
-        my $mesg = $ldap->bind;
-        if ( $mesg->is_error ) {
-            Catalyst::Exception->throw( "Error on Bind: " . $mesg->error );
-        }
+        $self->_ldap_bind_anon($ldap);
     }
     else {
         if ($bindpw) {
@@ -239,15 +242,20 @@ sub ldap_bind {
             }
         }
         else {
-            my $mesg = $ldap->bind($binddn);
-            if ( $mesg->is_error ) {
-                return undef;
-            }
+            $self->_ldap_bind_anon( $ldap, $binddn );
         }
     }
     return $ldap;
 }
 
+sub _ldap_bind_anon {
+    my ( $self, $ldap, $dn ) = @_;
+    my $mesg = $ldap->bind($dn);
+    if ( $mesg->is_error ) {
+        Catalyst::Exception->throw( "Error on Bind: " . $mesg->error );
+    }
+}
+
 =head2 lookup_user($id)
 
 Given a User ID, this method will:
@@ -255,11 +263,12 @@ Given a User ID, this method will:
   A) Bind to the directory using the configured binddn and bindpw
   B) Perform a search for the User Object in the directory, using
      user_basedn, user_filter, and user_scope.
-  C) Assuming we found the object, we will walk it's attributes 
+  C) Assuming we found the object, we will walk it's attributes
      using L<Net::LDAP::Entry>'s get_value method.  We store the
-     results in a hashref.
-  D) Return a hashref that looks like: 
-     
+     results in a hashref. If we do not find the object, then
+     undef is returned.
+  D) Return a hashref that looks like:
+
      $results = {
         'ldap_entry' => $entry, # The Net::LDAP::Entry object
         'attributes' => $attributes,
@@ -276,6 +285,9 @@ sub lookup_user {
     if ( $id =~ /\*/ ) {
         Catalyst::Exception->throw("ID $id contains wildcards!");
     }
+
+    # Trim trailing space or we confuse ourselves
+    $id =~ s/\s+$//;
     my $ldap = $self->ldap_bind;
     my @searchopts;
     if ( defined( $self->user_basedn ) ) {
@@ -292,10 +304,9 @@ sub lookup_user {
         push( @searchopts, %{ $self->user_search_options } );
     }
     my $usersearch = $ldap->search(@searchopts);
-    if ( $usersearch->is_error ) {
-        Catalyst::Exception->throw(
-            "LDAP Error while searching for user: " . $usersearch->error );
-    }
+
+    return undef if ( $usersearch->is_error );
+
     my $userentry;
     my $user_field     = $self->user_field;
     my $results_filter = $self->user_results_filter;
@@ -314,8 +325,11 @@ sub lookup_user {
 
     # 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 ( $entry->get_value($user_field) eq $id ) {
+        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."
             );
@@ -338,10 +352,8 @@ sub lookup_user {
             $attrhash->{ lc($attr) } = \@attrvalues;
         }
     }
-    my $load_class = $self->entry_class . ".pm";
-    $load_class =~ s|::|/|g;
 
-    eval { require $load_class };
+    eval { Catalyst::Utils::ensure_class_loaded( $self->entry_class ) };
     if ( !$@ ) {
         bless( $userentry, $self->entry_class );
         $userentry->{_use_unicode}++;
@@ -353,11 +365,12 @@ sub lookup_user {
     return $rv;
 }
 
-=head2 lookup_roles($userobj)
+=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 it's sole argument.
+as it's 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 it's criteria.
@@ -365,11 +378,11 @@ objects that match it's criteria.
 =cut
 
 sub lookup_roles {
-    my ( $self, $userobj ) = @_;
+    my ( $self, $userobj, $ldap ) = @_;
     if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) {
         return undef;
     }
-    my $ldap = $self->ldap_bind;
+    $ldap ||= $self->ldap_bind;
     my @searchopts;
     if ( defined( $self->role_basedn ) ) {
         push( @searchopts, 'base' => $self->role_basedn );
@@ -423,7 +436,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>.
 
@@ -431,7 +444,7 @@ Returns get_user() for I<id>.
 
 sub from_session {
     my ( $self, $c, $id ) = @_;
-    $self->get_user($id);
+    $self->get_user( $id, $c );
 }
 
 1;