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 | |
11 | You should be creating these objects through L<Catalyst::Authentication::Store::LDAP::Backend>'s "get_user" method, or just letting $c->login do |
12 | it for you. |
13 | |
14 | sub action : Local { |
15 | my ( $self, $c ) = @_; |
16 | $c->login($c->req->param(username), $c->req->param(password)); |
17 | $c->log->debug($c->user->username . "is really neat!"); |
18 | } |
19 | |
20 | If you access just $c->user in a scalar context, it will return the current |
21 | username. |
22 | |
23 | =head1 DESCRIPTION |
24 | |
25 | This wraps up an LDAP object and presents a simplified interface to it's |
26 | contents. It uses some AUTOLOAD magic to pass method calls it doesn't |
27 | understand through as simple read only accessors for the LDAP entries |
28 | various attributes. |
29 | |
30 | It gets grumpy if you ask for an attribute via the AUTOLOAD mechanism |
31 | that it doesn't know about. Avoid that with using "has_attribute", |
32 | discussed in more detail below. |
33 | |
34 | You can skip all that and just go straight to the L<Net::LDAP::Entry> |
35 | object through the "ldap_entry" method: |
36 | |
37 | my $entry = $c->user->ldap_entry; |
38 | |
39 | It also has support for Roles. |
40 | |
41 | =cut |
42 | |
43 | package Catalyst::Authentication::Store::LDAP::User; |
44 | use base qw( Catalyst::Authentication::User Class::Accessor::Fast ); |
45 | |
46 | use strict; |
47 | use warnings; |
48 | |
1f800a61 |
49 | our $VERSION = '0.1003'; |
f66d606b |
50 | |
51 | BEGIN { __PACKAGE__->mk_accessors(qw/user store/) } |
52 | |
53 | use overload '""' => sub { shift->stringify }, fallback => 1; |
54 | |
55 | =head1 METHODS |
56 | |
57 | =head2 new($store, $user) |
58 | |
59 | Takes a L<Catalyst::Authentication::Store::LDAP::Backend> object |
60 | as $store, and the data structure returned by that class's "get_user" |
61 | method as $user. |
62 | |
63 | Returns a L<Catalyst::Authentication::Store::LDAP::User> object. |
64 | |
65 | =cut |
66 | |
67 | sub new { |
68 | my ( $class, $store, $user ) = @_; |
69 | |
70 | return unless $user; |
71 | |
72 | bless { store => $store, user => $user, }, $class; |
73 | } |
74 | |
75 | =head2 id |
76 | |
77 | Returns the results of the "stringify" method. |
78 | |
79 | =cut |
80 | |
81 | sub id { |
82 | my $self = shift; |
83 | return $self->stringify; |
84 | } |
85 | |
86 | =head2 stringify |
87 | |
88 | Uses the "user_field" configuration option to determine what the "username" |
89 | of this object is, and returns it. |
90 | |
91 | If you use the special value "dn" for user_field, it will return the DN |
92 | of the L<Net::LDAP::Entry> object. |
93 | |
94 | =cut |
95 | |
96 | sub stringify { |
97 | my ($self) = @_; |
98 | my $userfield = $self->store->user_field; |
99 | $userfield = $$userfield[0] if ref $userfield eq 'ARRAY'; |
100 | if ( $userfield eq "dn" ) { |
101 | my ($string) = $self->user->ldap_entry->dn; |
102 | return $string; |
103 | } |
104 | else { |
105 | my ($string) = $self->$userfield; |
106 | return $string; |
107 | } |
108 | } |
109 | |
110 | =head2 supported_features |
111 | |
112 | Returns hashref of features that this Authentication::User subclass supports. |
113 | |
114 | =cut |
115 | |
116 | sub supported_features { |
117 | return { |
118 | password => { self_check => 1, }, |
119 | session => 1, |
120 | roles => { self_check => 0, }, |
121 | }; |
122 | } |
123 | |
124 | =head2 check_password($password) |
125 | |
126 | Bind's to the directory as the DN of the internal L<Net::LDAP::Entry> object, |
127 | using the bind password supplied in $password. Returns 1 on a successful |
128 | bind, 0 on failure. |
129 | |
130 | =cut |
131 | |
132 | sub check_password { |
133 | my ( $self, $password ) = @_; |
134 | my $ldap |
135 | = $self->store->ldap_bind( undef, $self->ldap_entry->dn, $password, |
136 | 'forauth' ); |
137 | if ( defined($ldap) ) { |
138 | return 1; |
139 | } |
140 | else { |
141 | return 0; |
142 | } |
143 | } |
144 | |
145 | =head2 roles |
146 | |
147 | Returns the results of L<Catalyst::Authentication::Store::LDAP::Backend>'s "lookup_roles" method, an array of roles that are valid for this user. |
148 | |
149 | =cut |
150 | |
151 | sub roles { |
152 | my $self = shift; |
153 | return $self->store->lookup_roles($self); |
154 | } |
155 | |
156 | =head2 for_session |
157 | |
158 | Returns the User object, stringified. |
159 | |
160 | =cut |
161 | |
162 | sub for_session { |
163 | my $self = shift; |
164 | return $self->stringify; |
165 | } |
166 | |
167 | =head2 ldap_entry |
168 | |
169 | Returns the raw ldap_entry. |
170 | |
171 | =cut |
172 | |
173 | sub ldap_entry { |
174 | my $self = shift; |
175 | return $self->user->{'ldap_entry'}; |
176 | } |
177 | |
178 | =head2 attributes($type) |
179 | |
180 | Returns an array of attributes present for this user. If $type is "ashash", |
181 | it will return a hash with the attribute names as keys. (And the values of |
182 | those attributes as, well, the values of the hash) |
183 | |
184 | =cut |
185 | |
186 | sub attributes { |
187 | my ( $self, $type ) = @_; |
188 | if ( $type eq "ashash" ) { |
189 | return $self->user->{'attributes'}; |
190 | } |
191 | else { |
192 | return keys( %{ $self->user->{'attributes'} } ); |
193 | } |
194 | } |
195 | |
196 | =head2 has_attribute |
197 | |
198 | Returns the values for an attribute, or undef if that attribute is not present. |
199 | The safest way to get at an attribute. |
200 | |
201 | =cut |
202 | |
203 | sub has_attribute { |
204 | my ( $self, $attribute ) = @_; |
205 | if ( !defined($attribute) ) { |
206 | Catalyst::Exception->throw( |
207 | "You must provide an attribute to has_attribute!"); |
208 | } |
209 | if ( $attribute eq "dn" ) { |
210 | return $self->ldap_entry->dn; |
211 | } |
212 | elsif ( exists( $self->user->{'attributes'}->{$attribute} ) ) { |
213 | return $self->user->{'attributes'}->{$attribute}; |
214 | } |
215 | else { |
216 | return undef; |
217 | } |
218 | } |
219 | |
220 | =head2 AUTOLOADed methods |
221 | |
222 | We automatically map the attributes of the underlying L<Net::LDAP::Entry> |
223 | object to read-only accessor methods. So, if you have an entry that looks |
224 | like this one: |
225 | |
226 | dn: cn=adam,ou=users,dc=yourcompany,dc=com |
227 | cn: adam |
228 | loginShell: /bin/zsh |
229 | homeDirectory: /home/adam |
230 | gecos: Adam Jacob |
231 | gidNumber: 100 |
232 | uidNumber: 1053 |
233 | mail: adam@yourcompany.com |
234 | uid: adam |
235 | givenName: Adam |
236 | sn: Jacob |
237 | objectClass: inetOrgPerson |
238 | objectClass: organizationalPerson |
239 | objectClass: Person |
240 | objectClass: Top |
241 | objectClass: posixAccount |
242 | |
243 | You can call: |
244 | |
245 | $c->user->homedirectory |
246 | |
247 | And you'll get the value of the "homeDirectory" attribute. Note that |
248 | all the AUTOLOADed methods are automatically lower-cased. |
249 | |
250 | =head2 Special Keywords |
251 | |
252 | The highly useful and common method "username" will map to the configured |
253 | value of user_field (uid by default.) |
254 | |
255 | $c->user->username == $c->user->uid |
256 | |
257 | =cut |
258 | |
259 | sub AUTOLOAD { |
260 | my $self = shift; |
261 | |
262 | ( my $method ) = ( our $AUTOLOAD =~ /([^:]+)$/ ); |
263 | |
264 | if ( $method eq "DESTROY" ) { |
265 | return; |
266 | } |
267 | if ( exists( $self->user->{'attributes'}->{$method} ) ) { |
268 | return $self->user->{'attributes'}->{$method}; |
269 | } |
270 | elsif ( $method eq "username" ) { |
271 | my $userfield = $self->store->user_field; |
272 | my $username = $self->has_attribute($userfield); |
273 | if ($username) { |
274 | return $username; |
275 | } |
276 | else { |
277 | Catalyst::Exception->throw( "User is missing the " |
278 | . $userfield |
279 | . " attribute, which should not be possible!" ); |
280 | } |
281 | } |
282 | else { |
283 | Catalyst::Exception->throw( |
284 | "No attribute $method for User " . $self->stringify ); |
285 | } |
286 | } |
287 | |
288 | 1; |
289 | |
290 | __END__ |
291 | |
292 | =head1 AUTHORS |
293 | |
294 | Adam Jacob <holoway@cpan.org> |
295 | |
296 | Some parts stolen shamelessly and entirely from |
297 | L<Catalyst::Plugin::Authentication::Store::Htpasswd>. |
298 | |
299 | Currently maintained by Peter Karman <karman@cpan.org>. |
300 | |
301 | =head1 THANKS |
302 | |
303 | To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :) |
304 | |
305 | =head1 SEE ALSO |
306 | |
307 | L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::Backend>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP> |
308 | |
309 | =head1 COPYRIGHT & LICENSE |
310 | |
311 | Copyright (c) 2005 the aforementioned authors. All rights |
312 | reserved. This program is free software; you can redistribute |
313 | it and/or modify it under the same terms as Perl itself. |
314 | |
315 | =cut |
316 | |