Commit | Line | Data |
f66d606b |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
9638f14b |
6 | Catalyst::Authentication::Store::LDAP::Backend |
f66d606b |
7 | - LDAP authentication storage backend. |
8 | |
9 | =head1 SYNOPSIS |
10 | |
11 | # you probably just want Store::LDAP under most cases, |
12 | # but if you insist you can instantiate your own store: |
13 | |
14 | use Catalyst::Authentication::Store::LDAP::Backend; |
15 | |
16 | use Catalyst qw/ |
17 | Authentication |
18 | Authentication::Credential::Password |
19 | /; |
20 | |
21 | my %config = ( |
22 | 'ldap_server' => 'ldap1.yourcompany.com', |
23 | 'ldap_server_options' => { |
24 | 'timeout' => 30, |
25 | }, |
26 | 'binddn' => 'anonymous', |
27 | 'bindpw' => 'dontcarehow', |
28 | 'start_tls' => 1, |
29 | 'start_tls_options' => { |
30 | 'verify' => 'none', |
31 | }, |
32 | 'user_basedn' => 'ou=people,dc=yourcompany,dc=com', |
33 | 'user_filter' => '(&(objectClass=posixAccount)(uid=%s))', |
57d476f1 |
34 | 'user_scope' => 'one', # or 'sub' for Active Directory |
f66d606b |
35 | 'user_field' => 'uid', |
36 | 'user_search_options' => { |
37 | 'deref' => 'always', |
a03db022 |
38 | 'attrs' => [qw( distinguishedname name mail )], |
f66d606b |
39 | }, |
1647b33a |
40 | 'user_results_filter' => sub { return shift->pop_entry }, |
f66d606b |
41 | 'entry_class' => 'MyApp::LDAP::Entry', |
405489b5 |
42 | 'user_class' => 'MyUser', |
f66d606b |
43 | 'use_roles' => 1, |
44 | 'role_basedn' => 'ou=groups,dc=yourcompany,dc=com', |
45 | 'role_filter' => '(&(objectClass=posixGroup)(member=%s))', |
46 | 'role_scope' => 'one', |
47 | 'role_field' => 'cn', |
48 | 'role_value' => 'dn', |
49 | 'role_search_options' => { |
50 | 'deref' => 'always', |
51 | }, |
405489b5 |
52 | 'role_search_as_user' => 0, |
439924cb |
53 | 'persist_in_session' => 'all', |
f66d606b |
54 | ); |
9638f14b |
55 | |
f66d606b |
56 | our $users = Catalyst::Authentication::Store::LDAP::Backend->new(\%config); |
57 | |
f66d606b |
58 | =head1 DESCRIPTION |
59 | |
afb8e81c |
60 | You probably want L<Catalyst::Authentication::Store::LDAP>. |
f66d606b |
61 | |
afb8e81c |
62 | Otherwise, this lets you create a store manually. |
f66d606b |
63 | |
64 | See the L<Catalyst::Authentication::Store::LDAP> documentation for |
65 | an explanation of the configuration options. |
66 | |
67 | =head1 METHODS |
68 | |
69 | =cut |
70 | |
71 | package Catalyst::Authentication::Store::LDAP::Backend; |
72 | use base qw( Class::Accessor::Fast ); |
73 | |
74 | use strict; |
75 | use warnings; |
76 | |
0d3c4264 |
77 | our $VERSION = '1.016'; |
f66d606b |
78 | |
79 | use Catalyst::Authentication::Store::LDAP::User; |
80 | use Net::LDAP; |
405489b5 |
81 | use Catalyst::Utils (); |
8aab9b07 |
82 | use Catalyst::Exception; |
f66d606b |
83 | |
84 | BEGIN { |
85 | __PACKAGE__->mk_accessors( |
86 | qw( ldap_server ldap_server_options binddn |
87 | bindpw entry_class user_search_options |
88 | user_filter user_basedn user_scope |
89 | user_attrs user_field use_roles role_basedn |
90 | role_filter role_scope role_field role_value |
91 | role_search_options start_tls start_tls_options |
405489b5 |
92 | user_results_filter user_class role_search_as_user |
439924cb |
93 | persist_in_session |
f66d606b |
94 | ) |
95 | ); |
96 | } |
97 | |
98 | =head2 new($config) |
99 | |
100 | Creates a new L<Catalyst::Authentication::Store::LDAP::Backend> object. |
101 | $config should be a hashref, which should contain the configuration options |
102 | listed in L<Catalyst::Authentication::Store::LDAP>'s documentation. |
103 | |
104 | Also sets a few sensible defaults. |
105 | |
106 | =cut |
107 | |
108 | sub new { |
109 | my ( $class, $config ) = @_; |
110 | |
111 | unless ( defined($config) && ref($config) eq "HASH" ) { |
112 | Catalyst::Exception->throw( |
113 | "Catalyst::Authentication::Store::LDAP::Backend needs to be configured with a hashref." |
114 | ); |
115 | } |
116 | my %config_hash = %{$config}; |
117 | $config_hash{'binddn'} ||= 'anonymous'; |
118 | $config_hash{'user_filter'} ||= '(uid=%s)'; |
119 | $config_hash{'user_scope'} ||= 'sub'; |
120 | $config_hash{'user_field'} ||= 'uid'; |
121 | $config_hash{'role_filter'} ||= '(memberUid=%s)'; |
122 | $config_hash{'role_scope'} ||= 'sub'; |
123 | $config_hash{'role_field'} ||= 'cn'; |
06d130c2 |
124 | $config_hash{'use_roles'} = '1' |
125 | unless exists $config_hash{use_roles}; |
f66d606b |
126 | $config_hash{'start_tls'} ||= '0'; |
127 | $config_hash{'entry_class'} ||= 'Catalyst::Model::LDAP::Entry'; |
d05c83dd |
128 | $config_hash{'user_class'} |
129 | ||= 'Catalyst::Authentication::Store::LDAP::User'; |
405489b5 |
130 | $config_hash{'role_search_as_user'} ||= 0; |
d7ddb040 |
131 | $config_hash{'persist_in_session'} ||= 'username'; |
4f7db831 |
132 | Catalyst::Exception->throw('persist_in_session must be either username or all') |
133 | unless $config_hash{'persist_in_session'} =~ /\A(?:username|all)\z/; |
f66d606b |
134 | |
d05c83dd |
135 | Catalyst::Utils::ensure_class_loaded( $config_hash{'user_class'} ); |
f66d606b |
136 | my $self = \%config_hash; |
137 | bless( $self, $class ); |
138 | return $self; |
139 | } |
140 | |
52a972a4 |
141 | =head2 find_user( I<authinfo>, $c ) |
f66d606b |
142 | |
143 | Creates a L<Catalyst::Authentication::Store::LDAP::User> object |
9638f14b |
144 | for the given User ID. This is the preferred mechanism for getting a |
f66d606b |
145 | given User out of the Store. |
146 | |
147 | I<authinfo> should be a hashref with a key of either C<id> or |
148 | C<username>. The value will be compared against the LDAP C<user_field> field. |
149 | |
150 | =cut |
151 | |
152 | sub find_user { |
153 | my ( $self, $authinfo, $c ) = @_; |
52a972a4 |
154 | return $self->get_user( $authinfo->{id} || $authinfo->{username}, $c ); |
f66d606b |
155 | } |
156 | |
5faab354 |
157 | =head2 get_user( I<id>, $c) |
f66d606b |
158 | |
159 | Creates a L<Catalyst::Authentication::Store::LDAP::User> object |
52a972a4 |
160 | for the given User ID, or calls C<new> on the class specified in |
161 | C<user_class>. This instance of the store object, the results of |
162 | C<lookup_user> and $c are passed as arguments (in that order) to C<new>. |
163 | This is the preferred mechanism for getting a given User out of the Store. |
f66d606b |
164 | |
165 | =cut |
166 | |
167 | sub get_user { |
52a972a4 |
168 | my ( $self, $id, $c ) = @_; |
d05c83dd |
169 | my $user = $self->user_class->new( $self, $self->lookup_user($id), $c ); |
f66d606b |
170 | return $user; |
171 | } |
172 | |
173 | =head2 ldap_connect |
174 | |
175 | Returns a L<Net::LDAP> object, connected to your LDAP server. (According |
176 | to how you configured the Backend, of course) |
177 | |
178 | =cut |
179 | |
180 | sub ldap_connect { |
181 | my ($self) = shift; |
182 | my $ldap; |
183 | if ( defined( $self->ldap_server_options() ) ) { |
184 | $ldap |
185 | = Net::LDAP->new( $self->ldap_server, |
186 | %{ $self->ldap_server_options } ) |
187 | or Catalyst::Exception->throw($@); |
188 | } |
189 | else { |
190 | $ldap = Net::LDAP->new( $self->ldap_server ) |
191 | or Catalyst::Exception->throw($@); |
192 | } |
193 | if ( defined( $self->start_tls ) && $self->start_tls =~ /(1|true)/i ) { |
194 | my $mesg; |
195 | if ( defined( $self->start_tls_options ) ) { |
196 | $mesg = $ldap->start_tls( %{ $self->start_tls_options } ); |
197 | } |
198 | else { |
199 | $mesg = $ldap->start_tls; |
200 | } |
201 | if ( $mesg->is_error ) { |
202 | Catalyst::Exception->throw( "TLS Error: " . $mesg->error ); |
203 | } |
204 | } |
205 | return $ldap; |
206 | } |
207 | |
208 | =head2 ldap_bind($ldap, $binddn, $bindpw) |
209 | |
210 | Bind's to the directory. If $ldap is undef, it will connect to the |
211 | LDAP server first. $binddn should be the DN of the object you wish |
212 | to bind as, and $bindpw the password. |
213 | |
214 | If $binddn is "anonymous", an anonymous bind will be performed. |
215 | |
216 | =cut |
217 | |
218 | sub ldap_bind { |
238a096f |
219 | my ( $self, $ldap, $binddn, $bindpw ) = @_; |
d05c83dd |
220 | $ldap ||= $self->ldap_connect; |
f66d606b |
221 | if ( !defined($ldap) ) { |
222 | Catalyst::Exception->throw("LDAP Server undefined!"); |
223 | } |
50f88c5d |
224 | |
225 | # if username is present, make sure password is present too. |
226 | # see https://rt.cpan.org/Ticket/Display.html?id=81908 |
227 | if ( !defined $binddn ) { |
228 | $binddn = $self->binddn; |
229 | $bindpw = $self->bindpw; |
230 | } |
231 | |
f66d606b |
232 | if ( $binddn eq "anonymous" ) { |
405489b5 |
233 | $self->_ldap_bind_anon($ldap); |
f66d606b |
234 | } |
235 | else { |
238a096f |
236 | if ($bindpw) { |
f66d606b |
237 | my $mesg = $ldap->bind( $binddn, 'password' => $bindpw ); |
238 | if ( $mesg->is_error ) { |
238a096f |
239 | Catalyst::Exception->throw( |
240 | "Error on Initial Bind: " . $mesg->error ); |
f66d606b |
241 | } |
242 | } |
243 | else { |
d05c83dd |
244 | $self->_ldap_bind_anon( $ldap, $binddn ); |
f66d606b |
245 | } |
246 | } |
247 | return $ldap; |
248 | } |
249 | |
405489b5 |
250 | sub _ldap_bind_anon { |
d05c83dd |
251 | my ( $self, $ldap, $dn ) = @_; |
405489b5 |
252 | my $mesg = $ldap->bind($dn); |
253 | if ( $mesg->is_error ) { |
254 | Catalyst::Exception->throw( "Error on Bind: " . $mesg->error ); |
255 | } |
256 | } |
257 | |
238a096f |
258 | =head2 ldap_auth( $binddn, $bindpw ) |
259 | |
260 | Connect to the LDAP server and do an authenticated bind against the |
261 | directory. Throws an exception if connecting to the LDAP server fails. |
262 | Returns 1 if binding succeeds, 0 if it fails. |
263 | |
264 | =cut |
265 | |
266 | sub ldap_auth { |
267 | my ( $self, $binddn, $bindpw ) = @_; |
268 | my $ldap = $self->ldap_connect; |
269 | if ( !defined $ldap ) { |
270 | Catalyst::Exception->throw("LDAP server undefined!"); |
271 | } |
272 | my $mesg = $ldap->bind( $binddn, password => $bindpw ); |
273 | return $mesg->is_error ? 0 : 1; |
274 | } |
275 | |
f66d606b |
276 | =head2 lookup_user($id) |
277 | |
278 | Given a User ID, this method will: |
279 | |
280 | A) Bind to the directory using the configured binddn and bindpw |
281 | B) Perform a search for the User Object in the directory, using |
282 | user_basedn, user_filter, and user_scope. |
71e3a4f6 |
283 | C) Assuming we found the object, we will walk its attributes |
f66d606b |
284 | using L<Net::LDAP::Entry>'s get_value method. We store the |
d94851da |
285 | results in a hashref. If we do not find the object, then |
286 | undef is returned. |
287 | D) Return a hashref that looks like: |
288 | |
f66d606b |
289 | $results = { |
290 | 'ldap_entry' => $entry, # The Net::LDAP::Entry object |
291 | 'attributes' => $attributes, |
292 | } |
293 | |
1647b33a |
294 | This method is usually only called by find_user(). |
f66d606b |
295 | |
296 | =cut |
297 | |
298 | sub lookup_user { |
299 | my ( $self, $id ) = @_; |
300 | |
02f3c071 |
301 | # Trim trailing space or we confuse ourselves |
302 | $id =~ s/\s+$//; |
f66d606b |
303 | my $ldap = $self->ldap_bind; |
304 | my @searchopts; |
305 | if ( defined( $self->user_basedn ) ) { |
306 | push( @searchopts, 'base' => $self->user_basedn ); |
307 | } |
308 | else { |
309 | Catalyst::Exception->throw( |
310 | "You must set user_basedn before looking up users!"); |
311 | } |
312 | my $filter = $self->_replace_filter( $self->user_filter, $id ); |
313 | push( @searchopts, 'filter' => $filter ); |
314 | push( @searchopts, 'scope' => $self->user_scope ); |
315 | if ( defined( $self->user_search_options ) ) { |
316 | push( @searchopts, %{ $self->user_search_options } ); |
317 | } |
318 | my $usersearch = $ldap->search(@searchopts); |
d94851da |
319 | |
a2f66fa8 |
320 | return undef if ( $usersearch->is_error ); |
d94851da |
321 | |
f66d606b |
322 | my $userentry; |
1647b33a |
323 | my $user_field = $self->user_field; |
324 | my $results_filter = $self->user_results_filter; |
325 | my $entry; |
326 | if ( defined($results_filter) ) { |
327 | $entry = &$results_filter($usersearch); |
328 | } |
329 | else { |
330 | $entry = $usersearch->pop_entry; |
331 | } |
332 | if ( $usersearch->pop_entry ) { |
333 | Catalyst::Exception->throw( |
334 | "More than one entry matches user search.\n" |
335 | . "Consider defining a user_results_filter sub." ); |
336 | } |
337 | |
338 | # a little extra sanity check with the 'eq' since LDAP already |
339 | # says it matches. |
5772b468 |
340 | # NOTE that Net::LDAP returns exactly what you asked for, but |
341 | # because LDAP is often case insensitive, FoO can match foo |
342 | # and so we normalize with lc(). |
1647b33a |
343 | if ( defined($entry) ) { |
5772b468 |
344 | unless ( lc( $entry->get_value($user_field) ) eq lc($id) ) { |
1647b33a |
345 | Catalyst::Exception->throw( |
346 | "LDAP claims '$user_field' equals '$id' but results entry does not match." |
347 | ); |
f66d606b |
348 | } |
1647b33a |
349 | $userentry = $entry; |
f66d606b |
350 | } |
1647b33a |
351 | |
f66d606b |
352 | $ldap->unbind; |
353 | $ldap->disconnect; |
354 | unless ($userentry) { |
355 | return undef; |
356 | } |
357 | my $attrhash; |
358 | foreach my $attr ( $userentry->attributes ) { |
359 | my @attrvalues = $userentry->get_value($attr); |
360 | if ( scalar(@attrvalues) == 1 ) { |
361 | $attrhash->{ lc($attr) } = $attrvalues[0]; |
362 | } |
363 | else { |
364 | $attrhash->{ lc($attr) } = \@attrvalues; |
365 | } |
366 | } |
d05c83dd |
367 | |
368 | eval { Catalyst::Utils::ensure_class_loaded( $self->entry_class ) }; |
f66d606b |
369 | if ( !$@ ) { |
370 | bless( $userentry, $self->entry_class ); |
371 | $userentry->{_use_unicode}++; |
372 | } |
373 | my $rv = { |
374 | 'ldap_entry' => $userentry, |
375 | 'attributes' => $attrhash, |
376 | }; |
377 | return $rv; |
378 | } |
379 | |
405489b5 |
380 | =head2 lookup_roles($userobj, [$ldap]) |
f66d606b |
381 | |
9638f14b |
382 | This method looks up the roles for a given user. It takes a |
f66d606b |
383 | L<Catalyst::Authentication::Store::LDAP::User> object |
71e3a4f6 |
384 | as its first argument, and can optionally take a I<Net::LDAP> object which |
405489b5 |
385 | is used rather than the default binding if supplied. |
f66d606b |
386 | |
387 | It returns an array containing the role_field attribute from all the |
71e3a4f6 |
388 | objects that match its criteria. |
f66d606b |
389 | |
390 | =cut |
391 | |
392 | sub lookup_roles { |
405489b5 |
393 | my ( $self, $userobj, $ldap ) = @_; |
f66d606b |
394 | if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) { |
e8af16df |
395 | return (); |
f66d606b |
396 | } |
5a9aba6e |
397 | $ldap ||= $self->role_search_as_user |
398 | ? $userobj->ldap_connection : $self->ldap_bind; |
f66d606b |
399 | my @searchopts; |
400 | if ( defined( $self->role_basedn ) ) { |
401 | push( @searchopts, 'base' => $self->role_basedn ); |
402 | } |
403 | else { |
404 | Catalyst::Exception->throw( |
405 | "You must set up role_basedn before looking up roles!"); |
406 | } |
407 | my $filter_value = $userobj->has_attribute( $self->role_value ); |
408 | if ( !defined($filter_value) ) { |
409 | Catalyst::Exception->throw( "User object " |
410 | . $userobj->username |
411 | . " has no " |
412 | . $self->role_value |
71e3a4f6 |
413 | . " attribute, so I can't look up its roles!" ); |
f66d606b |
414 | } |
415 | my $filter = $self->_replace_filter( $self->role_filter, $filter_value ); |
416 | push( @searchopts, 'filter' => $filter ); |
417 | push( @searchopts, 'scope' => $self->role_scope ); |
418 | push( @searchopts, 'attrs' => [ $self->role_field ] ); |
419 | if ( defined( $self->role_search_options ) ) { |
420 | push( @searchopts, %{ $self->role_search_options } ); |
421 | } |
422 | my $rolesearch = $ldap->search(@searchopts); |
423 | my @roles; |
ab62b426 |
424 | RESULT: foreach my $entry ( $rolesearch->entries ) { |
425 | push( @roles, $entry->get_value( $self->role_field ) ); |
f66d606b |
426 | } |
427 | return @roles; |
428 | } |
429 | |
430 | sub _replace_filter { |
431 | my $self = shift; |
432 | my $filter = shift; |
433 | my $replace = shift; |
18d41a8f |
434 | $replace =~ s/([*()\\\x{0}])/sprintf '\\%02x', ord($1)/ge; |
f66d606b |
435 | $filter =~ s/\%s/$replace/g; |
436 | return $filter; |
437 | } |
438 | |
439 | =head2 user_supports |
440 | |
9638f14b |
441 | Returns the value of |
f66d606b |
442 | Catalyst::Authentication::Store::LDAP::User->supports(@_). |
443 | |
444 | =cut |
445 | |
446 | sub user_supports { |
447 | my $self = shift; |
448 | |
449 | # this can work as a class method |
450 | Catalyst::Authentication::Store::LDAP::User->supports(@_); |
451 | } |
452 | |
e0c4eaa2 |
453 | =head2 from_session( I<id>, I<$c>, $frozenuser ) |
f66d606b |
454 | |
e0c4eaa2 |
455 | Revives a serialized user from storage in the session. |
f66d606b |
456 | |
e5e1d261 |
457 | Supports users stored with a different persist_in_session setting. |
458 | |
f66d606b |
459 | =cut |
460 | |
461 | sub from_session { |
439924cb |
462 | my ( $self, $c, $frozenuser ) = @_; |
463 | |
e5e1d261 |
464 | # we need to restore the user depending on the current storage of the |
465 | # user in the session store which might differ from what |
466 | # persist_in_session is set to now |
467 | if ( ref $frozenuser eq 'HASH' ) { |
468 | # we can rely on the existance of this key if the user is a hashref |
469 | if ( $frozenuser->{persist_in_session} eq 'all' ) { |
470 | return $self->user_class->new( $self, $frozenuser->{user}, $c, $frozenuser->{_roles} ); |
471 | } |
439924cb |
472 | } |
473 | |
474 | return $self->get_user( $frozenuser, $c ); |
f66d606b |
475 | } |
476 | |
477 | 1; |
478 | |
479 | __END__ |
480 | |
481 | =head1 AUTHORS |
482 | |
483 | Adam Jacob <holoway@cpan.org> |
484 | |
485 | Some parts stolen shamelessly and entirely from |
486 | L<Catalyst::Plugin::Authentication::Store::Htpasswd>. |
487 | |
488 | Currently maintained by Peter Karman <karman@cpan.org>. |
489 | |
490 | =head1 THANKS |
491 | |
492 | To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :) |
493 | |
494 | =head1 SEE ALSO |
495 | |
496 | L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::User>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP> |
497 | |
498 | =head1 COPYRIGHT & LICENSE |
499 | |
500 | Copyright (c) 2005 the aforementioned authors. All rights |
501 | reserved. This program is free software; you can redistribute |
502 | it and/or modify it under the same terms as Perl itself. |
503 | |
504 | =cut |
505 | |