From: Tomas Doran <bobtfish@bobtfish.net>
Date: Thu, 18 Mar 2010 21:32:28 +0000 (+0000)
Subject: Move user password out into a hash, fixing RT#53279
X-Git-Tag: v1.007~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Authentication-Store-LDAP.git;a=commitdiff_plain;h=8fe890e686a125fbb6f70afd6d95a9c6fe00b210

Move user password out into a hash, fixing RT#53279
---

diff --git a/Changes b/Changes
index bfe22c6..8a826d2 100644
--- a/Changes
+++ b/Changes
@@ -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)
diff --git a/lib/Catalyst/Authentication/Store/LDAP/User.pm b/lib/Catalyst/Authentication/Store/LDAP/User.pm
index d63c765..636728e 100644
--- a/lib/Catalyst/Authentication/Store/LDAP/User.pm
+++ b/lib/Catalyst/Authentication/Store/LDAP/User.pm
@@ -48,13 +48,17 @@ use base qw( Catalyst::Authentication::User Class::Accessor::Fast );
 
 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 @@ sub check_password {
             $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 @@ as, and returns a L<Net::LDAP> object which you can use to do further queries.
 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 @@ value of user_field (uid by default.)
 
 =cut
 
+sub DESTROY {
+    my $self = shift;
+    # Don't leak passwords..
+    delete $_ldap_connection_passwords{refaddr($self)};
+}
+
 sub AUTOLOAD {
     my $self = shift;
 
diff --git a/t/04-user_class.t b/t/04-user_class.t
index 283441f..29a32f8 100644
--- a/t/04-user_class.t
+++ b/t/04-user_class.t
@@ -4,15 +4,17 @@ use strict;
 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 @@ SKIP: {
 
     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';
+
 }
+