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.005';
  13
  14 BEGIN { __PACKAGE__->mk_accessors(qw/file user_field user_class/) }
  15
  16 sub new {
  17     my ($class, $config, $app, $realm) = @_;
  18
  19     my $file = delete $config->{file};
  20     unless (ref $file) {
  21         my $filename = ($file =~ m|^/|) ? $file : $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     $config->{user_class} ||= __PACKAGE__ . '::User';
  27     $config->{user_field} ||= 'username';
  28
  29     bless { %$config }, $class;
  30 }
  31
  32 sub find_user {
  33     my ($self, $authinfo, $c) = @_;
  34     my $htpasswd_user = $self->file->lookup_user($authinfo->{$self->user_field});
  35     $self->user_class->new( $self, $htpasswd_user );
  36 }
  37
  38 sub user_supports {
  39     my $self = shift;
  40
  41     # this can work as a class method, but in that case you can't have
  42     # a custom user class
  43     ref($self) ? $self->user_class->supports(@_)
  44         : Catalyst::Authentication::Store::Htpasswd::User->supports(@_);
  45 }
  46
  47 sub from_session {
  48         my ( $self, $c, $id ) = @_;
  49         $self->find_user( { username => $id } );
  50 }
  51
  52 1;
  53
  54 __END__
  55
  56 =pod
  57
  58 =head1 NAME
  59
  60 Catalyst::Authentication::Store::Htpasswd - Authen::Htpasswd based
  61 user storage/authentication.
  62
  63 =head1 SYNOPSIS
  64
  65     use Catalyst qw/
  66       Authentication
  67     /;
  68
  69     __PACKAGE__->config(
  70         authentication => {
  71             default_realm => 'test',
  72             realms => {
  73                 test => {
  74                     credential => {
  75                         class          => 'Password',
  76                         password_field => 'password',
  77                         password_type  => 'self_check',
  78                     },
  79                     store => {
  80                         class => 'Htpasswd',
  81                         file => 'htpasswd',
  82                     },
  83                 },
  84             },
  85         },
  86     );
  87
  88     sub login : Global {
  89         my ( $self, $c ) = @_;
  90
  91         $c->authenticate({ username => $c->req->param("login"), password => $c->req->param("password") });
  92     }
  93
  94 =head1 DESCRIPTION
  95
  96 This plugin uses L<Authen::Htpasswd> to let your application use C<<.htpasswd>>
  97 files for it's authentication storage.
  98
  99 =head1 METHODS
 100
 101 =head2 new
 102
 103 Simple constructor, dies if the htpassword file can't be found
 104
 105 =head2 find_user
 106
 107 Looks up the user, and returns a Catalyst::Authentication::Store::Htpasswd::User object.
 108
 109 =head2 user_supports
 110
 111 Delegates to L<Catalyst::Authentication::Store::Htpasswd::User->user_supports|Catalyst::Authentication::Store::Htpasswd::User#user_supports>
 112
 113 =head2 from_session
 114
 115 Delegates the user lookup to C<< find_user >>
 116
 117 =head1 CONFIGURATION
 118
 119 =head2 file
 120
 121 The path to the htpasswd file. If the path starts with a slash, then it is assumed to be a fully
 122 qualified path, otherwise the path is fed through C<< $c->path_to >> and so normalised to the
 123 application root.
 124
 125 Alternatively, it is possible to pass in an L<Authen::Htpasswd> object here, and this will be
 126 used as the htpasswd file.
 127
 128 =head2 user_class
 129
 130 Change the user class which this store returns. Defaults to L<Catalyst::Authentication::Store::Htpasswd::User>.
 131 This can be used to add additional functionality to the user class by sub-classing it, but will not normally be
 132 needed.
 133
 134 =head2 user_field
 135
 136 Change the field that the username is found in in the information passed into the call to C<< $c->authenticate() >>.
 137
 138 This defaults to I< username >, and generally you should be able to use the module as shown in the synopsis, however
 139 if you need a different field name then this setting can change the default.
 140
 141 Example:
 142
 143     __PACKAGE__->config( authentication => { realms => { test => {
 144                     store => {
 145                         class => 'Htpasswd',
 146                         user_field => 'email_address',
 147                     },
 148     }}});
 149     # Later in your code
 150     $c->authenticate({ email_address => $c->req->param("email"), password => $c->req->param("password") });
 151
 152 =head1 AUTHORS
 153
 154 Yuval Kogman C<<nothingmuch@woobling.org>>
 155
 156 David Kamholz C<<dkamholz@cpan.org>>
 157
 158 Tomas Doran C<<bobtfish@bobtfish.net>>
 159
 160 =head1 SEE ALSO
 161
 162 L<Authen::Htpasswd>.
 163
 164 =head1 COPYRIGHT & LICENSE
 165
 166         Copyright (c) 2005-2008 the aforementioned authors. All rights
 167         reserved. This program is free software; you can redistribute
 168         it and/or modify it under the same terms as Perl itself.
 169
 170 =cut
 171
 172