[Catalyst-commits] r13048 - in Catalyst-Authentication-Store-LDAP/trunk: . lib/Catalyst/Authentication/Store/LDAP t

t0m at dev.catalyst.perl.org t0m at dev.catalyst.perl.org
Thu Mar 18 21:32:28 GMT 2010


Author: t0m
Date: 2010-03-18 21:32:28 +0000 (Thu, 18 Mar 2010)
New Revision: 13048

Modified:
   Catalyst-Authentication-Store-LDAP/trunk/Changes
   Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
   Catalyst-Authentication-Store-LDAP/trunk/t/04-user_class.t
Log:
Move user password out into a hash, fixing RT#53279

Modified: Catalyst-Authentication-Store-LDAP/trunk/Changes
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/Changes	2010-03-18 09:00:21 UTC (rev 13047)
+++ Catalyst-Authentication-Store-LDAP/trunk/Changes	2010-03-18 21:32:28 UTC (rev 13048)
@@ -1,3 +1,7 @@
+   - Store the user password for the ldap_connection method in an inside
+     out hash rather than a closure so that the user object can be serialized
+     with Storable as people are putting them in the session (RT#53279)
+
 0.1006  11 Dec 2009
    - Pass $c along to find_user method so overridden user_class users can
      get at models (or whatever crazy things they might do) (gphat)

Modified: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm	2010-03-18 09:00:21 UTC (rev 13047)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm	2010-03-18 21:32:28 UTC (rev 13048)
@@ -48,13 +48,17 @@
 
 use strict;
 use warnings;
+use Scalar::Util qw/refaddr/;
 
 our $VERSION = '1.006';
 
-BEGIN { __PACKAGE__->mk_accessors(qw/user store _ldap_connection_password/) }
+BEGIN { __PACKAGE__->mk_accessors(qw/user store/) }
 
 use overload '""' => sub { shift->stringify }, fallback => 1;
 
+my %_ldap_connection_passwords; # Store inside-out so that they don't show up
+                                # in dumps..
+
 =head1 METHODS
 
 =head2 new($store, $user, $c)
@@ -147,9 +151,7 @@
             $self->roles($ldap);
         }
         # Stash a closure which can be used to retrieve the connection in the users context later.
-        $self->_ldap_connection_password( sub { $password } ); # Close over
-            # password to try to ensure it doesn't come out in debug dumps
-            # or get serialized into sessions etc..
+        $_ldap_connection_passwords{refaddr($self)} = $password;
         return 1;
     }
     else {
@@ -244,7 +246,7 @@
 sub ldap_connection {
     my $self = shift;
     $self->store->ldap_bind( undef, $self->ldap_entry->dn,
-        $self->_ldap_connection_password->() );
+        $_ldap_connection_passwords{refaddr($self)} );
 }
 
 =head2 AUTOLOADed methods
@@ -286,6 +288,12 @@
 
 =cut
 
+sub DESTROY {
+    my $self = shift;
+    # Don't leak passwords..
+    delete $_ldap_connection_passwords{refaddr($self)};
+}
+
 sub AUTOLOAD {
     my $self = shift;
 

Modified: Catalyst-Authentication-Store-LDAP/trunk/t/04-user_class.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/04-user_class.t	2010-03-18 09:00:21 UTC (rev 13047)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/04-user_class.t	2010-03-18 21:32:28 UTC (rev 13048)
@@ -4,15 +4,17 @@
 use warnings;
 use Catalyst::Exception;
 
-use Test::More tests => 5;
+use Test::More tests => 8;
 use lib 't/lib';
 use LDAPTest;
+use Storable qw/ freeze /;
+use Test::Exception;
 
 SKIP: {
 
     eval "use Catalyst::Model::LDAP";
     if ($@) {
-        skip "Catalyst::Model::LDAP not installed", 5;
+        skip "Catalyst::Model::LDAP not installed", 8;
     }
 
     my $server = LDAPTest::spawn_server();
@@ -40,4 +42,12 @@
 
     is( $user->my_method, 'frobnitz', "methods on user class work" );
 
+    $server = LDAPTest::spawn_server();
+    ok $user->check_password('foo'), 'Can check password';
+
+    my $frozen_user;
+    lives_ok { $frozen_user = freeze $user } 'Can freeze user with Storable';
+    ok $frozen_user, 'is frozen';
+
 }
+




More information about the Catalyst-commits mailing list