| Commit | Line | Data |
|---|
| f66d606b |
1 | |
| 2 | =pod |
| 3 | |
| 4 | =head1 NAME |
| 5 | |
| 6 | Catalyst::Authentication::Store::LDAP::Backend |
| 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))', |
| 34 | 'user_scope' => 'one', |
| 35 | 'user_field' => 'uid', |
| 36 | 'user_search_options' => { |
| 37 | 'deref' => 'always', |
| 38 | }, |
| 39 | 'entry_class' => 'MyApp::LDAP::Entry', |
| 40 | 'use_roles' => 1, |
| 41 | 'role_basedn' => 'ou=groups,dc=yourcompany,dc=com', |
| 42 | 'role_filter' => '(&(objectClass=posixGroup)(member=%s))', |
| 43 | 'role_scope' => 'one', |
| 44 | 'role_field' => 'cn', |
| 45 | 'role_value' => 'dn', |
| 46 | 'role_search_options' => { |
| 47 | 'deref' => 'always', |
| 48 | }, |
| 49 | ); |
| 50 | |
| 51 | our $users = Catalyst::Authentication::Store::LDAP::Backend->new(\%config); |
| 52 | |
| 53 | sub action : Local { |
| 54 | my ( $self, $c ) = @_; |
| 55 | |
| 56 | $c->login( $users->get_user( $c->req->param("login") ), |
| 57 | $c->req->param("password") ); |
| 58 | } |
| 59 | |
| 60 | =head1 DESCRIPTION |
| 61 | |
| 62 | You probably want L<Catalyst::Authentication::Store::LDAP>, unless |
| 63 | you are mixing several stores in a single app and one of them is LDAP. |
| 64 | |
| 65 | Otherwise, this lets you create a store manually. |
| 66 | |
| 67 | See the L<Catalyst::Authentication::Store::LDAP> documentation for |
| 68 | an explanation of the configuration options. |
| 69 | |
| 70 | =head1 METHODS |
| 71 | |
| 72 | =cut |
| 73 | |
| 74 | package Catalyst::Authentication::Store::LDAP::Backend; |
| 75 | use base qw( Class::Accessor::Fast ); |
| 76 | |
| 77 | use strict; |
| 78 | use warnings; |
| 79 | |
| 80 | our $VERSION = '0.1000'; |
| 81 | |
| 82 | use Catalyst::Authentication::Store::LDAP::User; |
| 83 | use Net::LDAP; |
| 84 | |
| 85 | BEGIN { |
| 86 | __PACKAGE__->mk_accessors( |
| 87 | qw( ldap_server ldap_server_options binddn |
| 88 | bindpw entry_class user_search_options |
| 89 | user_filter user_basedn user_scope |
| 90 | user_attrs user_field use_roles role_basedn |
| 91 | role_filter role_scope role_field role_value |
| 92 | role_search_options start_tls start_tls_options |
| 93 | ) |
| 94 | ); |
| 95 | } |
| 96 | |
| 97 | =head2 new($config) |
| 98 | |
| 99 | Creates a new L<Catalyst::Authentication::Store::LDAP::Backend> object. |
| 100 | $config should be a hashref, which should contain the configuration options |
| 101 | listed in L<Catalyst::Authentication::Store::LDAP>'s documentation. |
| 102 | |
| 103 | Also sets a few sensible defaults. |
| 104 | |
| 105 | =cut |
| 106 | |
| 107 | sub new { |
| 108 | my ( $class, $config ) = @_; |
| 109 | |
| 110 | unless ( defined($config) && ref($config) eq "HASH" ) { |
| 111 | Catalyst::Exception->throw( |
| 112 | "Catalyst::Authentication::Store::LDAP::Backend needs to be configured with a hashref." |
| 113 | ); |
| 114 | } |
| 115 | my %config_hash = %{$config}; |
| 116 | $config_hash{'binddn'} ||= 'anonymous'; |
| 117 | $config_hash{'user_filter'} ||= '(uid=%s)'; |
| 118 | $config_hash{'user_scope'} ||= 'sub'; |
| 119 | $config_hash{'user_field'} ||= 'uid'; |
| 120 | $config_hash{'role_filter'} ||= '(memberUid=%s)'; |
| 121 | $config_hash{'role_scope'} ||= 'sub'; |
| 122 | $config_hash{'role_field'} ||= 'cn'; |
| 123 | $config_hash{'use_roles'} ||= '1'; |
| 124 | $config_hash{'start_tls'} ||= '0'; |
| 125 | $config_hash{'entry_class'} ||= 'Catalyst::Model::LDAP::Entry'; |
| 126 | |
| 127 | my $self = \%config_hash; |
| 128 | bless( $self, $class ); |
| 129 | return $self; |
| 130 | } |
| 131 | |
| 132 | =head2 find_user( I<authinfo> ) |
| 133 | |
| 134 | Creates a L<Catalyst::Authentication::Store::LDAP::User> object |
| 135 | for the given User ID. This is the preferred mechanism for getting a |
| 136 | given User out of the Store. |
| 137 | |
| 138 | I<authinfo> should be a hashref with a key of either C<id> or |
| 139 | C<username>. The value will be compared against the LDAP C<user_field> field. |
| 140 | |
| 141 | =cut |
| 142 | |
| 143 | sub find_user { |
| 144 | my ( $self, $authinfo, $c ) = @_; |
| 145 | return $self->get_user( $authinfo->{id} || $authinfo->{username} ); |
| 146 | } |
| 147 | |
| 148 | =head2 get_user($id) |
| 149 | |
| 150 | Creates a L<Catalyst::Authentication::Store::LDAP::User> object |
| 151 | for the given User ID. This is the preferred mechanism for getting a |
| 152 | given User out of the Store. |
| 153 | |
| 154 | =cut |
| 155 | |
| 156 | sub get_user { |
| 157 | my ( $self, $id ) = @_; |
| 158 | my $user = Catalyst::Authentication::Store::LDAP::User->new( $self, |
| 159 | $self->lookup_user($id) ); |
| 160 | return $user; |
| 161 | } |
| 162 | |
| 163 | =head2 ldap_connect |
| 164 | |
| 165 | Returns a L<Net::LDAP> object, connected to your LDAP server. (According |
| 166 | to how you configured the Backend, of course) |
| 167 | |
| 168 | =cut |
| 169 | |
| 170 | sub ldap_connect { |
| 171 | my ($self) = shift; |
| 172 | my $ldap; |
| 173 | if ( defined( $self->ldap_server_options() ) ) { |
| 174 | $ldap |
| 175 | = Net::LDAP->new( $self->ldap_server, |
| 176 | %{ $self->ldap_server_options } ) |
| 177 | or Catalyst::Exception->throw($@); |
| 178 | } |
| 179 | else { |
| 180 | $ldap = Net::LDAP->new( $self->ldap_server ) |
| 181 | or Catalyst::Exception->throw($@); |
| 182 | } |
| 183 | if ( defined( $self->start_tls ) && $self->start_tls =~ /(1|true)/i ) { |
| 184 | my $mesg; |
| 185 | if ( defined( $self->start_tls_options ) ) { |
| 186 | $mesg = $ldap->start_tls( %{ $self->start_tls_options } ); |
| 187 | } |
| 188 | else { |
| 189 | $mesg = $ldap->start_tls; |
| 190 | } |
| 191 | if ( $mesg->is_error ) { |
| 192 | Catalyst::Exception->throw( "TLS Error: " . $mesg->error ); |
| 193 | } |
| 194 | } |
| 195 | return $ldap; |
| 196 | } |
| 197 | |
| 198 | =head2 ldap_bind($ldap, $binddn, $bindpw) |
| 199 | |
| 200 | Bind's to the directory. If $ldap is undef, it will connect to the |
| 201 | LDAP server first. $binddn should be the DN of the object you wish |
| 202 | to bind as, and $bindpw the password. |
| 203 | |
| 204 | If $binddn is "anonymous", an anonymous bind will be performed. |
| 205 | |
| 206 | =cut |
| 207 | |
| 208 | sub ldap_bind { |
| 209 | my ( $self, $ldap, $binddn, $bindpw, $forauth ) = @_; |
| 210 | $forauth ||= 0; |
| 211 | $ldap ||= $self->ldap_connect; |
| 212 | if ( !defined($ldap) ) { |
| 213 | Catalyst::Exception->throw("LDAP Server undefined!"); |
| 214 | } |
| 215 | $binddn ||= $self->binddn; |
| 216 | $bindpw ||= $self->bindpw; |
| 217 | if ( $binddn eq "anonymous" ) { |
| 218 | my $mesg = $ldap->bind; |
| 219 | if ( $mesg->is_error ) { |
| 220 | Catalyst::Exception->throw( "Error on Bind: " . $mesg->error ); |
| 221 | } |
| 222 | } |
| 223 | else { |
| 224 | if ($bindpw) { |
| 225 | my $mesg = $ldap->bind( $binddn, 'password' => $bindpw ); |
| 226 | if ( $mesg->is_error ) { |
| 227 | |
| 228 | # If we're not checking this bind for authentication purposes |
| 229 | # Go ahead an blow up if we fail. |
| 230 | if ( $forauth ne 'forauth' ) { |
| 231 | Catalyst::Exception->throw( |
| 232 | "Error on Initial Bind: " . $mesg->error ); |
| 233 | } |
| 234 | else { |
| 235 | return undef; |
| 236 | } |
| 237 | } |
| 238 | } |
| 239 | else { |
| 240 | my $mesg = $ldap->bind($binddn); |
| 241 | if ( $mesg->is_error ) { |
| 242 | return undef; |
| 243 | } |
| 244 | } |
| 245 | } |
| 246 | return $ldap; |
| 247 | } |
| 248 | |
| 249 | =head2 lookup_user($id) |
| 250 | |
| 251 | Given a User ID, this method will: |
| 252 | |
| 253 | A) Bind to the directory using the configured binddn and bindpw |
| 254 | B) Perform a search for the User Object in the directory, using |
| 255 | user_basedn, user_filter, and user_scope. |
| 256 | C) Assuming we found the object, we will walk it's attributes |
| 257 | using L<Net::LDAP::Entry>'s get_value method. We store the |
| 258 | results in a hashref. |
| 259 | D) Return a hashref that looks like: |
| 260 | |
| 261 | $results = { |
| 262 | 'ldap_entry' => $entry, # The Net::LDAP::Entry object |
| 263 | 'attributes' => $attributes, |
| 264 | } |
| 265 | |
| 266 | This method is usually only called by get_user. |
| 267 | |
| 268 | =cut |
| 269 | |
| 270 | sub lookup_user { |
| 271 | my ( $self, $id ) = @_; |
| 272 | |
| 273 | # No sneaking in wildcards! |
| 274 | if ( $id =~ /\*/ ) { |
| 275 | Catalyst::Exception->throw("ID $id contains wildcards!"); |
| 276 | } |
| 277 | my $ldap = $self->ldap_bind; |
| 278 | my @searchopts; |
| 279 | if ( defined( $self->user_basedn ) ) { |
| 280 | push( @searchopts, 'base' => $self->user_basedn ); |
| 281 | } |
| 282 | else { |
| 283 | Catalyst::Exception->throw( |
| 284 | "You must set user_basedn before looking up users!"); |
| 285 | } |
| 286 | my $filter = $self->_replace_filter( $self->user_filter, $id ); |
| 287 | push( @searchopts, 'filter' => $filter ); |
| 288 | push( @searchopts, 'scope' => $self->user_scope ); |
| 289 | if ( defined( $self->user_search_options ) ) { |
| 290 | push( @searchopts, %{ $self->user_search_options } ); |
| 291 | } |
| 292 | my $usersearch = $ldap->search(@searchopts); |
| 293 | if ( $usersearch->is_error ) { |
| 294 | Catalyst::Exception->throw( |
| 295 | "LDAP Error while searching for user: " . $usersearch->error ); |
| 296 | } |
| 297 | my $userentry; |
| 298 | my $user_field = $self->user_field; |
| 299 | my @user_fields |
| 300 | = ref $user_field eq 'ARRAY' ? @$user_field : ($user_field); |
| 301 | |
| 302 | # TODO check for multiple matches, which we should really not have. |
| 303 | RESULT: while ( my $entry = $usersearch->pop_entry ) { |
| 304 | foreach my $field (@user_fields) { |
| 305 | foreach my $value ( $entry->get_value($field) ) { |
| 306 | if ( $value eq $id ) { |
| 307 | $userentry = $entry; |
| 308 | last RESULT; |
| 309 | } |
| 310 | } |
| 311 | } |
| 312 | } |
| 313 | $ldap->unbind; |
| 314 | $ldap->disconnect; |
| 315 | unless ($userentry) { |
| 316 | return undef; |
| 317 | } |
| 318 | my $attrhash; |
| 319 | foreach my $attr ( $userentry->attributes ) { |
| 320 | my @attrvalues = $userentry->get_value($attr); |
| 321 | if ( scalar(@attrvalues) == 1 ) { |
| 322 | $attrhash->{ lc($attr) } = $attrvalues[0]; |
| 323 | } |
| 324 | else { |
| 325 | $attrhash->{ lc($attr) } = \@attrvalues; |
| 326 | } |
| 327 | } |
| 328 | my $load_class = $self->entry_class . ".pm"; |
| 329 | $load_class =~ s|::|/|g; |
| 330 | |
| 331 | eval { require $load_class }; |
| 332 | if ( !$@ ) { |
| 333 | bless( $userentry, $self->entry_class ); |
| 334 | $userentry->{_use_unicode}++; |
| 335 | } |
| 336 | my $rv = { |
| 337 | 'ldap_entry' => $userentry, |
| 338 | 'attributes' => $attrhash, |
| 339 | }; |
| 340 | return $rv; |
| 341 | } |
| 342 | |
| 343 | =head2 lookup_roles($userobj) |
| 344 | |
| 345 | This method looks up the roles for a given user. It takes a |
| 346 | L<Catalyst::Authentication::Store::LDAP::User> object |
| 347 | as it's sole argument. |
| 348 | |
| 349 | It returns an array containing the role_field attribute from all the |
| 350 | objects that match it's criteria. |
| 351 | |
| 352 | =cut |
| 353 | |
| 354 | sub lookup_roles { |
| 355 | my ( $self, $userobj ) = @_; |
| 356 | if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) { |
| 357 | return undef; |
| 358 | } |
| 359 | my $ldap = $self->ldap_bind; |
| 360 | my @searchopts; |
| 361 | if ( defined( $self->role_basedn ) ) { |
| 362 | push( @searchopts, 'base' => $self->role_basedn ); |
| 363 | } |
| 364 | else { |
| 365 | Catalyst::Exception->throw( |
| 366 | "You must set up role_basedn before looking up roles!"); |
| 367 | } |
| 368 | my $filter_value = $userobj->has_attribute( $self->role_value ); |
| 369 | if ( !defined($filter_value) ) { |
| 370 | Catalyst::Exception->throw( "User object " |
| 371 | . $userobj->username |
| 372 | . " has no " |
| 373 | . $self->role_value |
| 374 | . " attribute, so I can't look up it's roles!" ); |
| 375 | } |
| 376 | my $filter = $self->_replace_filter( $self->role_filter, $filter_value ); |
| 377 | push( @searchopts, 'filter' => $filter ); |
| 378 | push( @searchopts, 'scope' => $self->role_scope ); |
| 379 | push( @searchopts, 'attrs' => [ $self->role_field ] ); |
| 380 | if ( defined( $self->role_search_options ) ) { |
| 381 | push( @searchopts, %{ $self->role_search_options } ); |
| 382 | } |
| 383 | my $rolesearch = $ldap->search(@searchopts); |
| 384 | my @roles; |
| 385 | RESULT: while ( my $entry = $rolesearch->pop_entry ) { |
| 386 | my ($role) = $entry->get_value( $self->role_field ); |
| 387 | if ($role) { |
| 388 | push( @roles, $role ); |
| 389 | } |
| 390 | else { |
| 391 | next RESULT; |
| 392 | } |
| 393 | } |
| 394 | return @roles; |
| 395 | } |
| 396 | |
| 397 | sub _replace_filter { |
| 398 | my $self = shift; |
| 399 | my $filter = shift; |
| 400 | my $replace = shift; |
| 401 | $filter =~ s/\%s/$replace/g; |
| 402 | return $filter; |
| 403 | } |
| 404 | |
| 405 | =head2 user_supports |
| 406 | |
| 407 | Returns the value of |
| 408 | Catalyst::Authentication::Store::LDAP::User->supports(@_). |
| 409 | |
| 410 | =cut |
| 411 | |
| 412 | sub user_supports { |
| 413 | my $self = shift; |
| 414 | |
| 415 | # this can work as a class method |
| 416 | Catalyst::Authentication::Store::LDAP::User->supports(@_); |
| 417 | } |
| 418 | |
| 419 | =head2 from_session( I<id> ) |
| 420 | |
| 421 | Returns get_user() for I<id>. |
| 422 | |
| 423 | =cut |
| 424 | |
| 425 | sub from_session { |
| 426 | my ( $self, $c, $id ) = @_; |
| 427 | $self->get_user($id); |
| 428 | } |
| 429 | |
| 430 | 1; |
| 431 | |
| 432 | __END__ |
| 433 | |
| 434 | =head1 AUTHORS |
| 435 | |
| 436 | Adam Jacob <holoway@cpan.org> |
| 437 | |
| 438 | Some parts stolen shamelessly and entirely from |
| 439 | L<Catalyst::Plugin::Authentication::Store::Htpasswd>. |
| 440 | |
| 441 | Currently maintained by Peter Karman <karman@cpan.org>. |
| 442 | |
| 443 | =head1 THANKS |
| 444 | |
| 445 | To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :) |
| 446 | |
| 447 | =head1 SEE ALSO |
| 448 | |
| 449 | L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::User>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP> |
| 450 | |
| 451 | =head1 COPYRIGHT & LICENSE |
| 452 | |
| 453 | Copyright (c) 2005 the aforementioned authors. All rights |
| 454 | reserved. This program is free software; you can redistribute |
| 455 | it and/or modify it under the same terms as Perl itself. |
| 456 | |
| 457 | =cut |
| 458 | |
projects / catagits/Catalyst-Authentication-Store-LDAP.git / blame