lib/Catalyst/Authentication/Store/Htpasswd.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Authentication::Store::Htpasswd;
   4 use base qw/Class::Accessor::Fast/;
   5 use strict;
   6 use warnings;
   7
   8 use Authen::Htpasswd;
   9 use Catalyst::Authentication::Store::Htpasswd::User;
  10 use Scalar::Util qw/blessed/;
  11
  12 our $VERSION = '1.001';
  13
  14 BEGIN { __PACKAGE__->mk_accessors(qw/file/) }
  15
  16 sub new {
  17     my ($class, $config, $app, $realm) = @_;
  18
  19     my $file = delete $config->{file};
  20     unless (ref $file) { # FIXME - file not in app..
  21         my $filename = $app->path_to($file)->stringify;
  22         die("Cannot find htpasswd file: $filename\n") unless (-r $filename);
  23         $file = Authen::Htpasswd->new($filename);
  24     }
  25     $config->{file} = $file;
  26
  27     bless { %$config }, $class;
  28 }
  29
  30 sub find_user {
  31     my ($self, $authinfo, $c) = @_;
  32     # FIXME - change username
  33     my $htpasswd_user = $self->file->lookup_user($authinfo->{username});
  34     Catalyst::Authentication::Store::Htpasswd::User->new( $self, $htpasswd_user );
  35 }
  36
  37 sub user_supports {
  38     my $self = shift;
  39
  40     # this can work as a class method
  41     Catalyst::Authentication::Store::Htpasswd::User->supports(@_);
  42 }
  43
  44 sub from_session {
  45         my ( $self, $c, $id ) = @_;
  46         $self->find_user( { username => $id } );
  47 }
  48
  49 1;
  50
  51 __END__
  52
  53 =pod
  54
  55 =head1 NAME
  56
  57 Catalyst::Authentication::Store::Htpasswd - L<Authen::Htpasswd> based
  58 user storage/authentication.
  59
  60 =head1 SYNOPSIS
  61
  62     use Catalyst qw/
  63       Authentication
  64     /;
  65
  66     __PACKAGE__->config(
  67         authentication => {
  68             default_realm => 'test',
  69             realms => {
  70                 test => {
  71                     credential => {
  72                         class          => 'Password',
  73                         password_field => 'password',
  74                         password_type  => 'self_check',
  75                     },
  76                     store => {
  77                         class => 'Htpasswd',
  78                         file => 'htpasswd',
  79                     },
  80                 },
  81             },
  82         },
  83     );
  84
  85     sub login : Global {
  86         my ( $self, $c ) = @_;
  87
  88         $c->authenticate({ username => $c->req->param("login"), password => $c->req->param("password") });
  89     }
  90
  91 =head1 DESCRIPTION
  92
  93 This plugin uses C<Authen::Htpasswd> to let your application use C<.htpasswd>
  94 files for it's authentication storage.
  95
  96 =head1 METHODS
  97
  98 =head2 new
  99
 100 Simple constructor, dies if the htpassword file can't be found
 101
 102 =head2 find_user
 103
 104 Looks up the user, and returns a Catalyst::Authentication::Store::Htpasswd::User object.
 105
 106 =head2 user_supports
 107
 108 Delegates to L<Catalyst::Authentication::Store::Htpasswd::User->user_supports|Catalyst::Authentication::Store::Htpasswd::User#user_supports>
 109
 110 =head2 from_session
 111
 112 Delegates the user lookup to C< find_user >
 113
 114 =head1 CONFIGURATION
 115
 116 =head2 file
 117
 118 The path to the htpasswd file, this is taken from the application root.
 119
 120 =head1 AUTHORS
 121
 122 Yuval Kogman C<nothingmuch@woobling.org>
 123
 124 David Kamholz C<dkamholz@cpan.org>
 125
 126 Tomas Doran C<bobtfish@bobtfish.net>
 127
 128 =head1 SEE ALSO
 129
 130 L<Authen::Htpasswd>.
 131
 132 =head1 COPYRIGHT & LICENSE
 133
 134         Copyright (c) 2005-2008 the aforementioned authors. All rights
 135         reserved. This program is free software; you can redistribute
 136         it and/or modify it under the same terms as Perl itself.
 137
 138 =cut
 139
 140