[Catalyst-commits] r14073 - in trunk/Authen-Htpasswd: . lib/Authen t

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2011-08-09 11:14:48 +0000 (Tue, 09 Aug 2011)
New Revision: 14073

Modified:
   trunk/Authen-Htpasswd/Changes
   trunk/Authen-Htpasswd/Makefile.PL
   trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
   trunk/Authen-Htpasswd/t/05edit.t
Log:
fix user inflation code to handle arbitrary usernames

We were calling $_[0]->isa without first checking to see if it was an
object - this can either be an object or a username. However, the tests
only used usernames that were [a-z] - e.g. 'jim' - which meant that the
->isa was returning false rather than throwing an exception. I've modified
the test to use 3jim and updated the code to correctly check.


Modified: trunk/Authen-Htpasswd/Changes
===================================================================
--- trunk/Authen-Htpasswd/Changes	2011-08-08 08:45:03 UTC (rev 14072)
+++ trunk/Authen-Htpasswd/Changes	2011-08-09 11:14:48 UTC (rev 14073)
@@ -1,3 +1,5 @@
+    - fix user inflation code to handle arbitrary usernames
+
 0.161   Sun Oct 12 12:13:27 PDT 2008
     - fix stupid bug when trying to add a user that already exists (RT #37785)
     - fix \Q in regular expressions for newer versions of perl (RT #27012)

Modified: trunk/Authen-Htpasswd/Makefile.PL
===================================================================
--- trunk/Authen-Htpasswd/Makefile.PL	2011-08-08 08:45:03 UTC (rev 14072)
+++ trunk/Authen-Htpasswd/Makefile.PL	2011-08-09 11:14:48 UTC (rev 14073)
@@ -16,6 +16,7 @@
          'Digest'                => 0,
          'Digest::SHA1'          => 0,
          'Crypt::PasswdMD5'      => 0,
+         'Scalar::Util'          => 0,
     },
 
 );

Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm	2011-08-08 08:45:03 UTC (rev 14072)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm	2011-08-09 11:14:48 UTC (rev 14073)
@@ -6,6 +6,7 @@
 use IO::File;
 use IO::LockedFile;
 use Authen::Htpasswd::User;
+use Scalar::Util qw(blessed);
 
 use vars qw{$VERSION $SUFFIX};
 BEGIN {
@@ -240,7 +241,7 @@
 
 sub delete_user {
     my $self = shift;
-    my $username = $_[0]->isa('Authen::Htpasswd::User') ? $_[0]->username : $_[0];
+    my $username = blessed($_[0]) && $_[0]->isa('Authen::Htpasswd::User') ? $_[0]->username : $_[0];
 
     my ($old,$new) = $self->_start_rewrite;
     while (defined(my $line = <$old>)) {
@@ -261,7 +262,7 @@
 
 sub _get_user {
     my $self = shift;
-    return $_[0] if $_[0]->isa('Authen::Htpasswd::User');
+    return $_[0] if blessed($_[0]) && $_[0]->isa('Authen::Htpasswd::User');
     my $attr = ref $_[-1] eq 'HASH' ? pop @_ : {};
     $attr->{encrypt_hash} ||= $self->encrypt_hash;
     $attr->{check_hashes} ||= $self->check_hashes;

Modified: trunk/Authen-Htpasswd/t/05edit.t
===================================================================
--- trunk/Authen-Htpasswd/t/05edit.t	2011-08-08 08:45:03 UTC (rev 14072)
+++ trunk/Authen-Htpasswd/t/05edit.t	2011-08-09 11:14:48 UTC (rev 14073)
@@ -18,15 +18,18 @@
 
 ok( $file, 'object created successfully');
 
-ok( $file->add_user(qw/ jim frobnicate /), 'new user created' );
-ok( $file->check_user_password(qw/ jim frobnicate /), 'new user verified' );
+# we need to have a user with a name that isn't a valid perl package to
+# avoid hiding a bug where we call $_[0]->isa on the username.
 
+ok( $file->add_user(qw/ 3jim frobnicate /), 'new user created' );
+ok( $file->check_user_password(qw/ 3jim frobnicate /), 'new user verified' );
+
 ok( $file->update_user(qw/ fred frobble /), 'user updated' );
 ok( $file->check_user_password(qw/ fred frobble /), 'updated user verified' );
 ok( !$file->check_user_password(qw/ fred fribble /), 'old password invalid' );
 
-ok( $file->delete_user('jim'), 'deleted user' );
-eval { $file->check_user_password(qw/ jim frobnicate /) };
+ok( $file->delete_user('3jim'), 'deleted user' );
+eval { $file->check_user_password(qw/ 3jim frobnicate /) };
 ok( $@, 'deleted user not found' );
 
 my $user = $file->lookup_user('bob');