fix lookup_roles to return an empty list instead of undef
[catagits/Catalyst-Authentication-Store-LDAP.git] / lib / Catalyst / Authentication / Store / LDAP / Backend.pm
index 36df48b..bd7bae0 100644 (file)
@@ -3,7 +3,7 @@
 
 =head1 NAME
 
-Catalyst::Authentication::Store::LDAP::Backend 
+Catalyst::Authentication::Store::LDAP::Backend
   - LDAP authentication storage backend.
 
 =head1 SYNOPSIS
@@ -31,10 +31,11 @@ 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',
+                'attrs' => [qw( distinguishedname name mail )],
             },
             'user_results_filter' => sub { return shift->pop_entry },
             'entry_class' => 'MyApp::LDAP::Entry',
@@ -49,23 +50,16 @@ Catalyst::Authentication::Store::LDAP::Backend
                 'deref' => 'always',
             },
             'role_search_as_user' => 0,
+            'persist_in_session'  => 'all',
     );
-    
-    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") );
-    }
+    our $users = Catalyst::Authentication::Store::LDAP::Backend->new(\%config);
 
 =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.
@@ -80,11 +74,12 @@ use base qw( Class::Accessor::Fast );
 use strict;
 use warnings;
 
-our $VERSION = '0.1004';
+our $VERSION = '1.015';
 
 use Catalyst::Authentication::Store::LDAP::User;
 use Net::LDAP;
 use Catalyst::Utils ();
+use Catalyst::Exception;
 
 BEGIN {
     __PACKAGE__->mk_accessors(
@@ -95,6 +90,7 @@ BEGIN {
             role_filter role_scope role_field role_value
             role_search_options start_tls start_tls_options
             user_results_filter user_class role_search_as_user
+            persist_in_session
             )
     );
 }
@@ -125,22 +121,27 @@ sub new {
     $config_hash{'role_filter'} ||= '(memberUid=%s)';
     $config_hash{'role_scope'}  ||= 'sub';
     $config_hash{'role_field'}  ||= 'cn';
-    $config_hash{'use_roles'}   ||= '1';
+    $config_hash{'use_roles'}   = '1'
+        unless exists $config_hash{use_roles};
     $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;
+    $config_hash{'persist_in_session'}  ||= 'username';
+    Catalyst::Exception->throw('persist_in_session must be either username or all')
+        unless $config_hash{'persist_in_session'} =~ /\A(?:username|all)\z/;
 
-    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;
 }
 
-=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 
+for the given User ID.  This is the preferred mechanism for getting a
 given User out of the Store.
 
 I<authinfo> should be a hashref with a key of either C<id> or
@@ -150,21 +151,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 = $self->user_class->new( $self,
-        $self->lookup_user($id) );
+    my ( $self, $id, $c ) = @_;
+    my $user = $self->user_class->new( $self, $self->lookup_user($id), $c );
     return $user;
 }
 
@@ -214,14 +216,19 @@ If $binddn is "anonymous", an anonymous bind will be performed.
 =cut
 
 sub ldap_bind {
-    my ( $self, $ldap, $binddn, $bindpw, $forauth ) = @_;
-    $forauth ||= 0;
-    $ldap    ||= $self->ldap_connect;
+    my ( $self, $ldap, $binddn, $bindpw ) = @_;
+    $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);
     }
@@ -229,33 +236,43 @@ sub ldap_bind {
         if ($bindpw) {
             my $mesg = $ldap->bind( $binddn, 'password' => $bindpw );
             if ( $mesg->is_error ) {
-
-                # If we're not checking this bind for authentication purposes
-                # Go ahead an blow up if we fail.
-                if ( $forauth ne 'forauth' ) {
-                    Catalyst::Exception->throw(
-                        "Error on Initial Bind: " . $mesg->error );
-                }
-                else {
-                    return undef;
-                }
+                Catalyst::Exception->throw(
+                    "Error on Initial Bind: " . $mesg->error );
             }
         }
         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 );
     }
 }
 
+=head2 ldap_auth( $binddn, $bindpw )
+
+Connect to the LDAP server and do an authenticated bind against the
+directory. Throws an exception if connecting to the LDAP server fails.
+Returns 1 if binding succeeds, 0 if it fails.
+
+=cut
+
+sub ldap_auth {
+    my ( $self, $binddn, $bindpw ) = @_;
+    my $ldap = $self->ldap_connect;
+    if ( !defined $ldap ) {
+        Catalyst::Exception->throw("LDAP server undefined!");
+    }
+    my $mesg = $ldap->bind( $binddn, password => $bindpw );
+    return $mesg->is_error ? 0 : 1;
+}
+
 =head2 lookup_user($id)
 
 Given a User ID, this method will:
@@ -263,11 +280,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,
@@ -280,10 +298,8 @@ 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;
     my @searchopts;
     if ( defined( $self->user_basedn ) ) {
@@ -300,10 +316,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;
@@ -349,8 +364,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}++;
@@ -364,7 +379,7 @@ sub lookup_user {
 
 =head2 lookup_roles($userobj, [$ldap])
 
-This method looks up the roles for a given user.  It takes a 
+This method looks up the roles for a given user.  It takes a
 L<Catalyst::Authentication::Store::LDAP::User> object
 as it's first argument, and can optionally take a I<Net::LDAP> object which
 is used rather than the default binding if supplied.
@@ -377,9 +392,10 @@ objects that match it's criteria.
 sub lookup_roles {
     my ( $self, $userobj, $ldap ) = @_;
     if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) {
-        return undef;
+        return ();
     }
-    $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 );
@@ -415,13 +431,14 @@ 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;
 }
 
 =head2 user_supports
 
-Returns the value of 
+Returns the value of
 Catalyst::Authentication::Store::LDAP::User->supports(@_).
 
 =cut
@@ -433,15 +450,28 @@ sub user_supports {
     Catalyst::Authentication::Store::LDAP::User->supports(@_);
 }
 
-=head2 from_session( I<id> )
+=head2 from_session( I<id>, I<$c>, $frozenuser )
+
+Revives a serialized user from storage in the session.
 
-Returns get_user() for I<id>.
+Supports users stored with a different persist_in_session setting.
 
 =cut
 
 sub from_session {
-    my ( $self, $c, $id ) = @_;
-    $self->get_user($id);
+    my ( $self, $c, $frozenuser ) = @_;
+
+    # we need to restore the user depending on the current storage of the
+    # user in the session store which might differ from what
+    # persist_in_session is set to now
+    if ( ref $frozenuser eq 'HASH' ) {
+        # we can rely on the existance of this key if the user is a hashref
+        if ( $frozenuser->{persist_in_session} eq 'all' ) {
+            return $self->user_class->new( $self, $frozenuser->{user}, $c, $frozenuser->{_roles} );
+        }
+    }
+
+    return $self->get_user( $frozenuser, $c );
 }
 
 1;