| Commit | Line | Data |
|---|
| f66d606b |
1 | |
| 2 | =pod |
| 3 | |
| 4 | =head1 NAME |
| 5 | |
| 6 | Catalyst::Authentication::Store::LDAP::User |
| 7 | - A User object representing an LDAP object. |
| 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 | |
| 28 | This wraps up an LDAP object and presents a simplified interface to it's |
| 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 |
| 31 | various attributes. |
| 32 | |
| 33 | It gets grumpy if you ask for an attribute via the AUTOLOAD mechanism |
| 34 | that it doesn't know about. Avoid that with using "has_attribute", |
| 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; |
| 51 | |
| d94851da |
52 | our $VERSION = '0.1005'; |
| f66d606b |
53 | |
| 57e643d2 |
54 | BEGIN { __PACKAGE__->mk_accessors(qw/user store _ldap_connection/) } |
| f66d606b |
55 | |
| 56 | use overload '""' => sub { shift->stringify }, fallback => 1; |
| 57 | |
| 58 | =head1 METHODS |
| 59 | |
| 52a972a4 |
60 | =head2 new($store, $user, $c) |
| f66d606b |
61 | |
| 62 | Takes a L<Catalyst::Authentication::Store::LDAP::Backend> object |
| 63 | as $store, and the data structure returned by that class's "get_user" |
| 52a972a4 |
64 | method as $user. The final argument is an instance of your application, |
| 65 | which is passed along for those wanting to subclass User and perhaps use |
| 66 | models for fetching data. |
| f66d606b |
67 | |
| 68 | Returns a L<Catalyst::Authentication::Store::LDAP::User> object. |
| 69 | |
| 70 | =cut |
| 71 | |
| 72 | sub new { |
| 52a972a4 |
73 | my ( $class, $store, $user, $c ) = @_; |
| f66d606b |
74 | |
| 75 | return unless $user; |
| 76 | |
| 77 | bless { store => $store, user => $user, }, $class; |
| 78 | } |
| 79 | |
| 80 | =head2 id |
| 81 | |
| 82 | Returns the results of the "stringify" method. |
| 83 | |
| 84 | =cut |
| 85 | |
| 86 | sub id { |
| 87 | my $self = shift; |
| 88 | return $self->stringify; |
| 89 | } |
| 90 | |
| 91 | =head2 stringify |
| 92 | |
| 93 | Uses the "user_field" configuration option to determine what the "username" |
| 94 | of this object is, and returns it. |
| 95 | |
| 96 | If you use the special value "dn" for user_field, it will return the DN |
| 97 | of the L<Net::LDAP::Entry> object. |
| 98 | |
| 99 | =cut |
| 100 | |
| 101 | sub stringify { |
| 102 | my ($self) = @_; |
| 103 | my $userfield = $self->store->user_field; |
| 104 | $userfield = $$userfield[0] if ref $userfield eq 'ARRAY'; |
| 105 | if ( $userfield eq "dn" ) { |
| 106 | my ($string) = $self->user->ldap_entry->dn; |
| 107 | return $string; |
| 108 | } |
| 109 | else { |
| 110 | my ($string) = $self->$userfield; |
| 111 | return $string; |
| 112 | } |
| 113 | } |
| 114 | |
| 115 | =head2 supported_features |
| 116 | |
| 117 | Returns hashref of features that this Authentication::User subclass supports. |
| 118 | |
| 119 | =cut |
| 120 | |
| 121 | sub supported_features { |
| 122 | return { |
| 123 | password => { self_check => 1, }, |
| 124 | session => 1, |
| 125 | roles => { self_check => 0, }, |
| 126 | }; |
| 127 | } |
| 128 | |
| 129 | =head2 check_password($password) |
| 130 | |
| 131 | Bind's to the directory as the DN of the internal L<Net::LDAP::Entry> object, |
| 132 | using the bind password supplied in $password. Returns 1 on a successful |
| 133 | bind, 0 on failure. |
| 134 | |
| 135 | =cut |
| 136 | |
| 137 | sub check_password { |
| 138 | my ( $self, $password ) = @_; |
| 139 | my $ldap |
| 140 | = $self->store->ldap_bind( undef, $self->ldap_entry->dn, $password, |
| 141 | 'forauth' ); |
| 142 | if ( defined($ldap) ) { |
| 405489b5 |
143 | if ($self->store->role_search_as_user) { |
| 57e643d2 |
144 | # FIXME - This can be removed and made to use the code below.. |
| 405489b5 |
145 | # Have to do the role lookup _now_, as this is the only time |
| 146 | # that we have the user's password/ldap bind.. |
| 147 | $self->roles($ldap); |
| 148 | } |
| 57e643d2 |
149 | # Stash a closure which can be used to retrieve the connection in the users context later. |
| 460d3d61 |
150 | $self->_ldap_connection( sub { |
| 151 | $self->store->ldap_bind( undef, $self->ldap_entry->dn, $password ) |
| 152 | }); |
| f66d606b |
153 | return 1; |
| 154 | } |
| 155 | else { |
| 156 | return 0; |
| 157 | } |
| 158 | } |
| 159 | |
| 160 | =head2 roles |
| 161 | |
| 162 | Returns the results of L<Catalyst::Authentication::Store::LDAP::Backend>'s "lookup_roles" method, an array of roles that are valid for this user. |
| 163 | |
| 164 | =cut |
| 165 | |
| 166 | sub roles { |
| 167 | my $self = shift; |
| 405489b5 |
168 | my $ldap = shift; |
| 169 | $self->{_roles} ||= [$self->store->lookup_roles($self, $ldap)]; |
| 170 | return @{$self->{_roles}}; |
| f66d606b |
171 | } |
| 172 | |
| 173 | =head2 for_session |
| 174 | |
| 175 | Returns the User object, stringified. |
| 176 | |
| 177 | =cut |
| 178 | |
| 179 | sub for_session { |
| 180 | my $self = shift; |
| 181 | return $self->stringify; |
| 182 | } |
| 183 | |
| 184 | =head2 ldap_entry |
| 185 | |
| 186 | Returns the raw ldap_entry. |
| 187 | |
| 188 | =cut |
| 189 | |
| 190 | sub ldap_entry { |
| 191 | my $self = shift; |
| 192 | return $self->user->{'ldap_entry'}; |
| 193 | } |
| 194 | |
| 195 | =head2 attributes($type) |
| 196 | |
| 197 | Returns an array of attributes present for this user. If $type is "ashash", |
| 198 | it will return a hash with the attribute names as keys. (And the values of |
| 199 | those attributes as, well, the values of the hash) |
| 200 | |
| 201 | =cut |
| 202 | |
| 203 | sub attributes { |
| 204 | my ( $self, $type ) = @_; |
| 205 | if ( $type eq "ashash" ) { |
| 206 | return $self->user->{'attributes'}; |
| 207 | } |
| 208 | else { |
| 209 | return keys( %{ $self->user->{'attributes'} } ); |
| 210 | } |
| 211 | } |
| 212 | |
| 213 | =head2 has_attribute |
| 214 | |
| 215 | Returns the values for an attribute, or undef if that attribute is not present. |
| 216 | The safest way to get at an attribute. |
| 217 | |
| 218 | =cut |
| 219 | |
| 220 | sub has_attribute { |
| 221 | my ( $self, $attribute ) = @_; |
| 222 | if ( !defined($attribute) ) { |
| 223 | Catalyst::Exception->throw( |
| 224 | "You must provide an attribute to has_attribute!"); |
| 225 | } |
| 226 | if ( $attribute eq "dn" ) { |
| 227 | return $self->ldap_entry->dn; |
| 228 | } |
| 229 | elsif ( exists( $self->user->{'attributes'}->{$attribute} ) ) { |
| 230 | return $self->user->{'attributes'}->{$attribute}; |
| 231 | } |
| 232 | else { |
| 233 | return undef; |
| 234 | } |
| 235 | } |
| 236 | |
| 237 | =head2 AUTOLOADed methods |
| 238 | |
| 239 | We automatically map the attributes of the underlying L<Net::LDAP::Entry> |
| 240 | object to read-only accessor methods. So, if you have an entry that looks |
| 241 | like this one: |
| 242 | |
| 243 | dn: cn=adam,ou=users,dc=yourcompany,dc=com |
| 244 | cn: adam |
| 245 | loginShell: /bin/zsh |
| 246 | homeDirectory: /home/adam |
| 247 | gecos: Adam Jacob |
| 248 | gidNumber: 100 |
| 249 | uidNumber: 1053 |
| 250 | mail: adam@yourcompany.com |
| 251 | uid: adam |
| 252 | givenName: Adam |
| 253 | sn: Jacob |
| 254 | objectClass: inetOrgPerson |
| 255 | objectClass: organizationalPerson |
| 256 | objectClass: Person |
| 257 | objectClass: Top |
| 258 | objectClass: posixAccount |
| 259 | |
| 260 | You can call: |
| 261 | |
| 262 | $c->user->homedirectory |
| 263 | |
| 264 | And you'll get the value of the "homeDirectory" attribute. Note that |
| 265 | all the AUTOLOADed methods are automatically lower-cased. |
| 266 | |
| 267 | =head2 Special Keywords |
| 268 | |
| 269 | The highly useful and common method "username" will map to the configured |
| 270 | value of user_field (uid by default.) |
| 271 | |
| 272 | $c->user->username == $c->user->uid |
| 273 | |
| 274 | =cut |
| 275 | |
| 276 | sub AUTOLOAD { |
| 277 | my $self = shift; |
| 278 | |
| 279 | ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ ); |
| 280 | |
| 281 | if ( $method eq "DESTROY" ) { |
| 282 | return; |
| 283 | } |
| 284 | if ( exists( $self->user->{'attributes'}->{$method} ) ) { |
| 285 | return $self->user->{'attributes'}->{$method}; |
| 286 | } |
| 287 | elsif ( $method eq "username" ) { |
| 288 | my $userfield = $self->store->user_field; |
| 289 | my $username = $self->has_attribute($userfield); |
| 290 | if ($username) { |
| 291 | return $username; |
| 292 | } |
| 293 | else { |
| 294 | Catalyst::Exception->throw( "User is missing the " |
| 295 | . $userfield |
| 296 | . " attribute, which should not be possible!" ); |
| 297 | } |
| 298 | } |
| 299 | else { |
| 300 | Catalyst::Exception->throw( |
| 301 | "No attribute $method for User " . $self->stringify ); |
| 302 | } |
| 303 | } |
| 304 | |
| 305 | 1; |
| 306 | |
| 307 | __END__ |
| 308 | |
| 309 | =head1 AUTHORS |
| 310 | |
| 311 | Adam Jacob <holoway@cpan.org> |
| 312 | |
| 313 | Some parts stolen shamelessly and entirely from |
| 314 | L<Catalyst::Plugin::Authentication::Store::Htpasswd>. |
| 315 | |
| 316 | Currently maintained by Peter Karman <karman@cpan.org>. |
| 317 | |
| 318 | =head1 THANKS |
| 319 | |
| 320 | To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :) |
| 321 | |
| 322 | =head1 SEE ALSO |
| 323 | |
| 324 | L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::Backend>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP> |
| 325 | |
| 326 | =head1 COPYRIGHT & LICENSE |
| 327 | |
| 328 | Copyright (c) 2005 the aforementioned authors. All rights |
| 329 | reserved. This program is free software; you can redistribute |
| 330 | it and/or modify it under the same terms as Perl itself. |
| 331 | |
| 332 | =cut |
| 333 | |
projects / catagits/Catalyst-Authentication-Store-LDAP.git / blame