lib/Catalyst/Authentication/Store/LDAP/User.pm

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