Commit | Line | Data |
16585083 |
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 | |
1fad0d36 |
12 | our $VERSION = '1.004'; |
16585083 |
13 | |
1dc06313 |
14 | BEGIN { __PACKAGE__->mk_accessors(qw/file user_field user_class/) } |
16585083 |
15 | |
16 | sub new { |
17 | my ($class, $config, $app, $realm) = @_; |
18 | |
19 | my $file = delete $config->{file}; |
1dc06313 |
20 | unless (ref $file) { |
21 | my $filename = ($file =~ m|^/|) ? $file : $app->path_to($file)->stringify; |
16585083 |
22 | die("Cannot find htpasswd file: $filename\n") unless (-r $filename); |
23 | $file = Authen::Htpasswd->new($filename); |
24 | } |
25 | $config->{file} = $file; |
1dc06313 |
26 | $config->{user_class} ||= __PACKAGE__ . '::User'; |
27 | $config->{user_field} ||= 'username'; |
16585083 |
28 | |
29 | bless { %$config }, $class; |
30 | } |
31 | |
32 | sub find_user { |
33 | my ($self, $authinfo, $c) = @_; |
1dc06313 |
34 | my $htpasswd_user = $self->file->lookup_user($authinfo->{$self->user_field}); |
35 | $self->user_class->new( $self, $htpasswd_user ); |
16585083 |
36 | } |
37 | |
38 | sub user_supports { |
39 | my $self = shift; |
40 | |
1dc06313 |
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(@_); |
16585083 |
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 | |
1dc06313 |
60 | Catalyst::Authentication::Store::Htpasswd - Authen::Htpasswd based |
16585083 |
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 | |
8ba206fe |
96 | This plugin uses L<Authen::Htpasswd> to let your application use C<<.htpasswd>> |
16585083 |
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 | |
8ba206fe |
115 | Delegates the user lookup to C<< find_user >> |
16585083 |
116 | |
117 | =head1 CONFIGURATION |
118 | |
119 | =head2 file |
120 | |
1dc06313 |
121 | The path to the htpasswd file. If the path starts with a slash, then it is assumed to be a fully |
4149fcc0 |
122 | qualified path, otherwise the path is fed through C<< $c->path_to >> and so normalised to the |
1dc06313 |
123 | application root. |
124 | |
8bddfbc8 |
125 | Alternatively, it is possible to pass in an L<Authen::Htpasswd> object here, and this will be |
1dc06313 |
126 | used as the htpasswd file. |
127 | |
128 | =head2 user_class |
129 | |
8bddfbc8 |
130 | Change the user class which this store returns. Defaults to L<Catalyst::Authentication::Store::Htpasswd::User>. |
1dc06313 |
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 | |
8ba206fe |
136 | Change the field that the username is found in in the information passed into the call to C<< $c->authenticate() >>. |
1dc06313 |
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") }); |
16585083 |
151 | |
152 | =head1 AUTHORS |
153 | |
8ba206fe |
154 | Yuval Kogman C<<nothingmuch@woobling.org>> |
16585083 |
155 | |
8ba206fe |
156 | David Kamholz C<<dkamholz@cpan.org>> |
16585083 |
157 | |
8ba206fe |
158 | Tomas Doran C<<bobtfish@bobtfish.net>> |
16585083 |
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 | |