htpasswd backend works
Yuval Kogman [Fri, 4 Nov 2005 22:06:25 +0000 (22:06 +0000)]
lib/Catalyst/Plugin/Authentication/Store/Htpasswd.pm
lib/Catalyst/Plugin/Authentication/Store/Htpasswd/Backend.pm
lib/Catalyst/Plugin/Authentication/Store/Htpasswd/User.pm [new file with mode: 0644]
t/backend.t [new file with mode: 0644]

index 2dfb066..428e9ba 100644 (file)
@@ -1,18 +1,18 @@
 #!/usr/bin/perl
 
-package Catalyst::Plugin::Authentication::Store::Minimal;
+package Catalyst::Plugin::Authentication::Store::Htpasswd;
 
 use strict;
 use warnings;
 
-use Catalyst::Plugin::Authentication::Store::Minimal::Backend;
+use Catalyst::Plugin::Authentication::Store::Htpasswd::Backend;
 
 sub setup {
     my $c = shift;
 
     $c->default_auth_store(
-        Catalyst::Plugin::Authentication::Store::Minimal::Backend->new(
-            $c->config->{authentication}{users}
+        Catalyst::Plugin::Authentication::Store::Htpasswd::Backend->new(
+            $c->config->{authentication}{htpasswd}
         )
     );
 
@@ -27,24 +27,18 @@ __END__
 
 =head1 NAME
 
-Catalyst::Plugin::Authentication::Store::Minimal - Authentication
+Catalyst::Plugin::Authentication::Store::Htpasswd - Authentication
 database in C<<$c->config>>.
 
 =head1 SYNOPSIS
 
     use Catalyst qw/
       Authentication
-      Authentication::Store::Minimal
+      Authentication::Store::Htpasswd
       Authentication::Credential::Password
       /;
 
-    __PACKAGE__->config->{authentication}{users} = {
-        name => {
-            password => "s3cr3t",
-            roles    => [qw/admin editor/],
-            ...
-        },
-    };
+    __PACKAGE__->config->{authentication}{htpasswd} = "...";
 
     sub login : Global {
         my ( $self, $c ) = @_;
@@ -54,14 +48,8 @@ database in C<<$c->config>>.
 
 =head1 DESCRIPTION
 
-This authentication store plugin lets you create a very quick and dirty user
-database in your application's config hash.
-
-It's purpose is mainly for testing, and it should probably be replaced by a
-more "serious" store for production.
-
-The hash in the config, as well as the user objects/hashes are freely mutable
-at runtime.
+This plugin uses C<Apache::Htpasswd> to let your application use C<.htpasswd>
+files for it's authentication storage.
 
 =head1 METHODS
 
@@ -74,6 +62,16 @@ L<Catalyst::Plugin::Authentication/default_auth_store> can use it.
 
 =back
 
+=head1 CONFIGURATION
+
+=over 4
+
+=item $c->config->{authentication}{htpasswd}
+
+The path to the htpasswd file.
+
+=back
+
 =cut
 
 
index 5eecd3d..c369ffe 100644 (file)
@@ -1,38 +1,34 @@
 #!/usr/bin/perl
 
-package Catalyst::Plugin::Authentication::Store::Minimal::Backend;
+package Catalyst::Plugin::Authentication::Store::Htpasswd::Backend;
+use base qw/Class::Accessor::Fast/;
 
 use strict;
 use warnings;
 
-use Catalyst::Plugin::Authentication::User::Hash;
-use Scalar::Util ();
+use Apache::Htpasswd;
+use Catalyst::Plugin::Authentication::Store::Htpasswd::User;
+
+BEGIN { __PACKAGE__->mk_accessors(qw/file/) }
 
 sub new {
-    my ( $class, $hash ) = @_;
+    my ( $class, $file, @extra) = @_;
 
-    bless { hash => $hash }, $class;
+    bless { file => ( ref($file) ? $file : Apache::Htpasswd->new($file, @extra) ) },
+      $class;
 }
 
 sub get_user {
     my ( $self, $id ) = @_;
-
-       my $user = $self->{hash}{$id};
-
-       bless $user, "Catalyst::Plugin::Authentication::User::Hash"
-         unless Scalar::Util::blessed($user);
-
-    return $user;
+    Catalyst::Plugin::Authentication::Store::Htpasswd::User->new( $id,
+        $self->file );
 }
 
 sub user_supports {
     my $self = shift;
 
-    # choose a random user
-    scalar keys %{ $self->{hash} };
-    ( undef, my $user ) = each %{ $self->{hash} };
-
-    $user->supports(@_);
+    # this can work as a class method
+    Catalyst::Plugin::Authentication::Store::Htpasswd::User->supports(@_);
 }
 
 __PACKAGE__;
@@ -43,15 +39,15 @@ __END__
 
 =head1 NAME
 
-Catalyst::Plugin::Authentication::Store::Minimal::Backend - Minimal
+Catalyst::Plugin::Authentication::Store::Htpasswd::Backend - Htpasswd
 authentication storage backend.
 
 =head1 SYNOPSIS
 
-    # you probably just want Store::Minimal under most cases,
+    # you probably just want Store::Htpasswd under most cases,
     # but if you insist you can instantiate your own store:
 
-    use Catalyst::Plugin::Authentication::Store::Minimal::Backend;
+    use Catalyst::Plugin::Authentication::Store::Htpasswd::Backend;
 
     use Catalyst qw/
         Authentication
@@ -62,7 +58,7 @@ authentication storage backend.
         user => { password => "s3cr3t" },
     );
     
-    our $users = Catalyst::Plugin::Authentication::Store::Minimal::Backend->new(\%users);
+    our $users = Catalyst::Plugin::Authentication::Store::Htpasswd::Backend->new(\%users);
 
     sub action : Local {
         my ( $self, $c ) = @_;
@@ -73,8 +69,8 @@ authentication storage backend.
 
 =head1 DESCRIPTION
 
-You probably want L<Catalyst::Plugin::Authentication::Store::Minimal>, unless
-you are mixing several stores in a single app and one of them is Minimal.
+You probably want L<Catalyst::Plugin::Authentication::Store::Htpasswd>, unless
+you are mixing several stores in a single app and one of them is Htpasswd.
 
 Otherwise, this lets you create a store manually.
 
diff --git a/lib/Catalyst/Plugin/Authentication/Store/Htpasswd/User.pm b/lib/Catalyst/Plugin/Authentication/Store/Htpasswd/User.pm
new file mode 100644 (file)
index 0000000..dc2bd83
--- /dev/null
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+package Catalyst::Plugin::Authentication::Store::Htpasswd::User;
+use base qw/Catalyst::Plugin::Authentication::User Class::Accessor::Fast/;
+
+use strict;
+use warnings;
+
+BEGIN { __PACKAGE__->mk_accessors(qw/file name/) }
+
+sub new {
+       my ( $class, $name, $file ) = @_;
+
+       bless {
+               name => $name,
+               file => $file,
+       }, $class;
+}
+
+sub supported_features {
+       return {
+               password => {
+                       self_check => 1,
+               }
+       };
+}
+
+sub check_password {
+       my ( $self, $password ) = @_;
+
+       return $self->file->htCheckPassword( $self->name, $password );
+}
+
+sub roles {
+       my $self = shift;
+       split( ",", $self->info_string );
+}
+
+sub info_string {
+       my $self = shift;
+       $self->file->fetchInfo( $self->name );
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Plugin::Authentication::Store::Htpasswd::User - A user object
+representing an entry in an htpasswd file.
+
+=head1 SYNOPSIS
+
+       use Catalyst::Plugin::Authentication::Store::Htpasswd::User;
+
+=head1 DESCRIPTION
+
+=cut
+
+
diff --git a/t/backend.t b/t/backend.t
new file mode 100644 (file)
index 0000000..bf47856
--- /dev/null
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Path::Class;
+
+use File::Temp qw/tempfile/;
+
+my $m; BEGIN { use_ok($m = "Catalyst::Plugin::Authentication::Store::Htpasswd::Backend") }
+
+(undef, my $tmp) = tempfile();
+
+my $passwd = Apache::Htpasswd->new({ passwdFile => "$tmp" });
+
+$passwd->htpasswd("user", "s3cr3t");
+
+
+can_ok($m, "new");
+isa_ok(my $o = $m->new( $passwd ), $m);
+
+can_ok($m, "file");
+isa_ok( $o->file, "Apache::Htpasswd");
+
+
+can_ok( $m, "user_supports");
+ok( $m->user_supports(qw/password self_check/), "user_supports self check" );
+
+can_ok($m, "get_user");
+isa_ok( my $u = $o->get_user("user"), "Catalyst::Plugin::Authentication::Store::Htpasswd::User");
+isa_ok( $u, "Catalyst::Plugin::Authentication::User");
+
+can_ok( $u, "supports");
+ok( $u->supports(qw/password self_check/), "htpasswd users check their own passwords");
+
+can_ok( $u, "check_password");
+ok( $u->check_password( "s3cr3t" ), "password is s3cr3t");
+
+