Commit | Line | Data |
f66d606b |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
6 | Catalyst::Authentication::Store::LDAP::User |
9638f14b |
7 | - A User object representing an LDAP object. |
f66d606b |
8 | |
9 | =head1 SYNOPSIS |
10 | |
afb8e81c |
11 | You should be creating these objects through L<Catalyst::Authentication::Store::LDAP::Backend>'s "get_user" method, or just letting $c->authenticate do |
f66d606b |
12 | it for you. |
13 | |
14 | sub action : Local { |
15 | my ( $self, $c ) = @_; |
afb8e81c |
16 | $c->authenticate({ |
17 | id => $c->req->param(username), |
18 | password => $c->req->param(password) |
19 | ); |
f66d606b |
20 | $c->log->debug($c->user->username . "is really neat!"); |
21 | } |
22 | |
23 | If you access just $c->user in a scalar context, it will return the current |
24 | username. |
25 | |
26 | =head1 DESCRIPTION |
27 | |
71e3a4f6 |
28 | This wraps up an LDAP object and presents a simplified interface to its |
f66d606b |
29 | contents. It uses some AUTOLOAD magic to pass method calls it doesn't |
30 | understand through as simple read only accessors for the LDAP entries |
9638f14b |
31 | various attributes. |
f66d606b |
32 | |
33 | It gets grumpy if you ask for an attribute via the AUTOLOAD mechanism |
9638f14b |
34 | that it doesn't know about. Avoid that with using "has_attribute", |
f66d606b |
35 | discussed in more detail below. |
36 | |
37 | You can skip all that and just go straight to the L<Net::LDAP::Entry> |
38 | object through the "ldap_entry" method: |
39 | |
40 | my $entry = $c->user->ldap_entry; |
41 | |
42 | It also has support for Roles. |
43 | |
44 | =cut |
45 | |
46 | package Catalyst::Authentication::Store::LDAP::User; |
47 | use base qw( Catalyst::Authentication::User Class::Accessor::Fast ); |
48 | |
49 | use strict; |
50 | use warnings; |
8fe890e6 |
51 | use Scalar::Util qw/refaddr/; |
aa44391e |
52 | use Net::LDAP::Entry; |
f66d606b |
53 | |
2690c1e3 |
54 | our $VERSION = '1.017'; |
f66d606b |
55 | |
8fe890e6 |
56 | BEGIN { __PACKAGE__->mk_accessors(qw/user store/) } |
f66d606b |
57 | |
58 | use overload '""' => sub { shift->stringify }, fallback => 1; |
59 | |
8fe890e6 |
60 | my %_ldap_connection_passwords; # Store inside-out so that they don't show up |
61 | # in dumps.. |
62 | |
f66d606b |
63 | =head1 METHODS |
64 | |
52a972a4 |
65 | =head2 new($store, $user, $c) |
f66d606b |
66 | |
67 | Takes a L<Catalyst::Authentication::Store::LDAP::Backend> object |
68 | as $store, and the data structure returned by that class's "get_user" |
52a972a4 |
69 | method as $user. The final argument is an instance of your application, |
70 | which is passed along for those wanting to subclass User and perhaps use |
71 | models for fetching data. |
f66d606b |
72 | |
73 | Returns a L<Catalyst::Authentication::Store::LDAP::User> object. |
74 | |
75 | =cut |
76 | |
77 | sub new { |
439924cb |
78 | my ( $class, $store, $user, $c, $roles ) = @_; |
f66d606b |
79 | |
80 | return unless $user; |
81 | |
439924cb |
82 | bless { store => $store, user => $user, _roles => $roles }, $class; |
f66d606b |
83 | } |
84 | |
85 | =head2 id |
86 | |
87 | Returns the results of the "stringify" method. |
88 | |
89 | =cut |
90 | |
91 | sub id { |
92 | my $self = shift; |
93 | return $self->stringify; |
94 | } |
95 | |
96 | =head2 stringify |
97 | |
98 | Uses the "user_field" configuration option to determine what the "username" |
99 | of this object is, and returns it. |
100 | |
101 | If you use the special value "dn" for user_field, it will return the DN |
102 | of the L<Net::LDAP::Entry> object. |
103 | |
104 | =cut |
105 | |
106 | sub stringify { |
107 | my ($self) = @_; |
108 | my $userfield = $self->store->user_field; |
109 | $userfield = $$userfield[0] if ref $userfield eq 'ARRAY'; |
110 | if ( $userfield eq "dn" ) { |
111 | my ($string) = $self->user->ldap_entry->dn; |
112 | return $string; |
113 | } |
114 | else { |
394e2cec |
115 | my $val = $self->$userfield; |
116 | return ref($val) eq 'ARRAY' ? $val->[0] : $val; |
f66d606b |
117 | } |
118 | } |
119 | |
120 | =head2 supported_features |
121 | |
122 | Returns hashref of features that this Authentication::User subclass supports. |
123 | |
124 | =cut |
125 | |
126 | sub supported_features { |
127 | return { |
128 | password => { self_check => 1, }, |
129 | session => 1, |
130 | roles => { self_check => 0, }, |
131 | }; |
132 | } |
133 | |
134 | =head2 check_password($password) |
135 | |
136 | Bind's to the directory as the DN of the internal L<Net::LDAP::Entry> object, |
137 | using the bind password supplied in $password. Returns 1 on a successful |
138 | bind, 0 on failure. |
139 | |
140 | =cut |
141 | |
142 | sub check_password { |
143 | my ( $self, $password ) = @_; |
238a096f |
144 | if ( $self->store->ldap_auth($self->ldap_entry->dn, $password) ) { |
57e643d2 |
145 | # Stash a closure which can be used to retrieve the connection in the users context later. |
8fe890e6 |
146 | $_ldap_connection_passwords{refaddr($self)} = $password; |
f66d606b |
147 | return 1; |
148 | } |
149 | else { |
150 | return 0; |
151 | } |
152 | } |
153 | |
154 | =head2 roles |
155 | |
156 | Returns the results of L<Catalyst::Authentication::Store::LDAP::Backend>'s "lookup_roles" method, an array of roles that are valid for this user. |
157 | |
158 | =cut |
159 | |
160 | sub roles { |
161 | my $self = shift; |
5a9aba6e |
162 | $self->{_roles} ||= [$self->store->lookup_roles($self)]; |
405489b5 |
163 | return @{$self->{_roles}}; |
f66d606b |
164 | } |
165 | |
166 | =head2 for_session |
167 | |
439924cb |
168 | Returns the user for persistence in the session depending on the |
169 | persist_in_session config option. |
f66d606b |
170 | |
e5e1d261 |
171 | Stores the persist_in_session setting so it can be used to revive the user |
172 | even if the setting has been changed. |
173 | |
f66d606b |
174 | =cut |
175 | |
176 | sub for_session { |
177 | my $self = shift; |
439924cb |
178 | |
179 | if ( $self->store->persist_in_session eq 'all' ) { |
180 | # use the roles accessor to ensure the roles are fetched |
e5e1d261 |
181 | return { |
182 | # store the persistance setting in the session to know how to |
183 | # restore the user |
184 | persist_in_session => $self->store->persist_in_session, |
185 | user => $self->user, |
186 | _roles => [ $self->roles ], |
187 | }; |
439924cb |
188 | } |
189 | |
f66d606b |
190 | return $self->stringify; |
191 | } |
192 | |
193 | =head2 ldap_entry |
194 | |
9638f14b |
195 | Returns the raw ldap_entry. |
f66d606b |
196 | |
197 | =cut |
198 | |
199 | sub ldap_entry { |
200 | my $self = shift; |
201 | return $self->user->{'ldap_entry'}; |
202 | } |
203 | |
204 | =head2 attributes($type) |
205 | |
206 | Returns an array of attributes present for this user. If $type is "ashash", |
207 | it will return a hash with the attribute names as keys. (And the values of |
208 | those attributes as, well, the values of the hash) |
209 | |
210 | =cut |
211 | |
212 | sub attributes { |
213 | my ( $self, $type ) = @_; |
214 | if ( $type eq "ashash" ) { |
215 | return $self->user->{'attributes'}; |
216 | } |
217 | else { |
218 | return keys( %{ $self->user->{'attributes'} } ); |
219 | } |
220 | } |
221 | |
222 | =head2 has_attribute |
223 | |
224 | Returns the values for an attribute, or undef if that attribute is not present. |
9638f14b |
225 | The safest way to get at an attribute. |
f66d606b |
226 | |
227 | =cut |
228 | |
229 | sub has_attribute { |
230 | my ( $self, $attribute ) = @_; |
231 | if ( !defined($attribute) ) { |
232 | Catalyst::Exception->throw( |
233 | "You must provide an attribute to has_attribute!"); |
234 | } |
235 | if ( $attribute eq "dn" ) { |
236 | return $self->ldap_entry->dn; |
237 | } |
a4427384 |
238 | elsif ( $attribute eq "username" ) { |
239 | return $self->user->{'attributes'}->{$self->store->user_field}; |
240 | } |
f66d606b |
241 | elsif ( exists( $self->user->{'attributes'}->{$attribute} ) ) { |
242 | return $self->user->{'attributes'}->{$attribute}; |
243 | } |
244 | else { |
245 | return undef; |
246 | } |
247 | } |
248 | |
57d476f1 |
249 | =head2 get |
250 | |
251 | A simple wrapper around has_attribute() to satisfy the Catalyst::Authentication::User API. |
252 | |
253 | =cut |
254 | |
255 | sub get { return shift->has_attribute(@_) } |
256 | |
257 | =head2 get_object |
258 | |
259 | Satisfies the Catalyst::Authentication::User API and returns the contents of the user() |
260 | attribute. |
261 | |
262 | =cut |
263 | |
264 | sub get_object { return shift->user } |
265 | |
da0d62e4 |
266 | =head2 ldap_connection |
267 | |
268 | Re-binds to the auth store with the credentials of the user you logged in |
269 | as, and returns a L<Net::LDAP> object which you can use to do further queries. |
270 | |
271 | =cut |
272 | |
273 | sub ldap_connection { |
274 | my $self = shift; |
89ab2886 |
275 | $self->store->ldap_bind( undef, $self->ldap_entry->dn, |
8fe890e6 |
276 | $_ldap_connection_passwords{refaddr($self)} ); |
da0d62e4 |
277 | } |
278 | |
f66d606b |
279 | =head2 AUTOLOADed methods |
280 | |
281 | We automatically map the attributes of the underlying L<Net::LDAP::Entry> |
282 | object to read-only accessor methods. So, if you have an entry that looks |
283 | like this one: |
284 | |
285 | dn: cn=adam,ou=users,dc=yourcompany,dc=com |
286 | cn: adam |
287 | loginShell: /bin/zsh |
288 | homeDirectory: /home/adam |
289 | gecos: Adam Jacob |
290 | gidNumber: 100 |
291 | uidNumber: 1053 |
292 | mail: adam@yourcompany.com |
293 | uid: adam |
294 | givenName: Adam |
295 | sn: Jacob |
296 | objectClass: inetOrgPerson |
297 | objectClass: organizationalPerson |
298 | objectClass: Person |
299 | objectClass: Top |
300 | objectClass: posixAccount |
301 | |
302 | You can call: |
303 | |
304 | $c->user->homedirectory |
305 | |
306 | And you'll get the value of the "homeDirectory" attribute. Note that |
9638f14b |
307 | all the AUTOLOADed methods are automatically lower-cased. |
f66d606b |
308 | |
309 | =head2 Special Keywords |
310 | |
311 | The highly useful and common method "username" will map to the configured |
9638f14b |
312 | value of user_field (uid by default.) |
f66d606b |
313 | |
314 | $c->user->username == $c->user->uid |
315 | |
316 | =cut |
317 | |
8fe890e6 |
318 | sub DESTROY { |
319 | my $self = shift; |
320 | # Don't leak passwords.. |
321 | delete $_ldap_connection_passwords{refaddr($self)}; |
322 | } |
323 | |
ec21cfdc |
324 | sub can { |
325 | my ($self, $method) = @_; |
326 | |
327 | return $self->SUPER::can($method) || do { |
328 | return unless $self->has_attribute($method); |
329 | return sub { $_[0]->has_attribute($method) }; |
330 | }; |
331 | } |
332 | |
f66d606b |
333 | sub AUTOLOAD { |
334 | my $self = shift; |
335 | |
336 | ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ ); |
337 | |
338 | if ( $method eq "DESTROY" ) { |
339 | return; |
340 | } |
a4427384 |
341 | |
342 | if ( my $attribute = $self->has_attribute($method) ) { |
343 | return $attribute; |
f66d606b |
344 | } |
345 | else { |
346 | Catalyst::Exception->throw( |
347 | "No attribute $method for User " . $self->stringify ); |
348 | } |
349 | } |
350 | |
351 | 1; |
352 | |
353 | __END__ |
354 | |
355 | =head1 AUTHORS |
356 | |
357 | Adam Jacob <holoway@cpan.org> |
358 | |
359 | Some parts stolen shamelessly and entirely from |
9638f14b |
360 | L<Catalyst::Plugin::Authentication::Store::Htpasswd>. |
f66d606b |
361 | |
362 | Currently maintained by Peter Karman <karman@cpan.org>. |
363 | |
364 | =head1 THANKS |
365 | |
366 | To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :) |
367 | |
368 | =head1 SEE ALSO |
369 | |
370 | L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::Backend>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP> |
371 | |
372 | =head1 COPYRIGHT & LICENSE |
373 | |
374 | Copyright (c) 2005 the aforementioned authors. All rights |
375 | reserved. This program is free software; you can redistribute |
376 | it and/or modify it under the same terms as Perl itself. |
377 | |
378 | =cut |
379 | |