=head1 NAME
Catalyst::Authentication::Store::LDAP::User
- - A User object representing an LDAP object.
+ - A User object representing an LDAP object.
=head1 SYNOPSIS
=head1 DESCRIPTION
-This wraps up an LDAP object and presents a simplified interface to it's
+This wraps up an LDAP object and presents a simplified interface to its
contents. It uses some AUTOLOAD magic to pass method calls it doesn't
understand through as simple read only accessors for the LDAP entries
-various attributes.
+various attributes.
It gets grumpy if you ask for an attribute via the AUTOLOAD mechanism
-that it doesn't know about. Avoid that with using "has_attribute",
+that it doesn't know about. Avoid that with using "has_attribute",
discussed in more detail below.
You can skip all that and just go straight to the L<Net::LDAP::Entry>
use strict;
use warnings;
+use Scalar::Util qw/refaddr/;
+use Net::LDAP::Entry;
-our $VERSION = '0.1005';
+our $VERSION = '1.017';
-BEGIN { __PACKAGE__->mk_accessors(qw/user store _ldap_connection_password/) }
+BEGIN { __PACKAGE__->mk_accessors(qw/user store/) }
use overload '""' => sub { shift->stringify }, fallback => 1;
+my %_ldap_connection_passwords; # Store inside-out so that they don't show up
+ # in dumps..
+
=head1 METHODS
=head2 new($store, $user, $c)
=cut
sub new {
- my ( $class, $store, $user, $c ) = @_;
+ my ( $class, $store, $user, $c, $roles ) = @_;
return unless $user;
- bless { store => $store, user => $user, }, $class;
+ bless { store => $store, user => $user, _roles => $roles }, $class;
}
=head2 id
return $string;
}
else {
- my ($string) = $self->$userfield;
- return $string;
+ my $val = $self->$userfield;
+ return ref($val) eq 'ARRAY' ? $val->[0] : $val;
}
}
sub check_password {
my ( $self, $password ) = @_;
- my $ldap
- = $self->store->ldap_bind( undef, $self->ldap_entry->dn, $password,
- 'forauth' );
- if ( defined($ldap) ) {
- if ($self->store->role_search_as_user) {
- # FIXME - This can be removed and made to use the code below..
- # Have to do the role lookup _now_, as this is the only time
- # that we have the user's password/ldap bind..
- $self->roles($ldap);
- }
+ if ( $self->store->ldap_auth($self->ldap_entry->dn, $password) ) {
# Stash a closure which can be used to retrieve the connection in the users context later.
- $self->_ldap_connection_password( sub { $password } ); # Close over
- # password to try to ensure it doesn't come out in debug dumps
- # or get serialized into sessions etc..
+ $_ldap_connection_passwords{refaddr($self)} = $password;
return 1;
}
else {
sub roles {
my $self = shift;
- my $ldap = shift;
- $self->{_roles} ||= [$self->store->lookup_roles($self, $ldap)];
+ $self->{_roles} ||= [$self->store->lookup_roles($self)];
return @{$self->{_roles}};
}
=head2 for_session
-Returns the User object, stringified.
+Returns the user for persistence in the session depending on the
+persist_in_session config option.
+
+Stores the persist_in_session setting so it can be used to revive the user
+even if the setting has been changed.
=cut
sub for_session {
my $self = shift;
+
+ if ( $self->store->persist_in_session eq 'all' ) {
+ # use the roles accessor to ensure the roles are fetched
+ return {
+ # store the persistance setting in the session to know how to
+ # restore the user
+ persist_in_session => $self->store->persist_in_session,
+ user => $self->user,
+ _roles => [ $self->roles ],
+ };
+ }
+
return $self->stringify;
}
=head2 ldap_entry
-Returns the raw ldap_entry.
+Returns the raw ldap_entry.
=cut
=head2 has_attribute
Returns the values for an attribute, or undef if that attribute is not present.
-The safest way to get at an attribute.
+The safest way to get at an attribute.
=cut
if ( $attribute eq "dn" ) {
return $self->ldap_entry->dn;
}
+ elsif ( $attribute eq "username" ) {
+ return $self->user->{'attributes'}->{$self->store->user_field};
+ }
elsif ( exists( $self->user->{'attributes'}->{$attribute} ) ) {
return $self->user->{'attributes'}->{$attribute};
}
}
}
+=head2 get
+
+A simple wrapper around has_attribute() to satisfy the Catalyst::Authentication::User API.
+
+=cut
+
+sub get { return shift->has_attribute(@_) }
+
+=head2 get_object
+
+Satisfies the Catalyst::Authentication::User API and returns the contents of the user()
+attribute.
+
+=cut
+
+sub get_object { return shift->user }
+
=head2 ldap_connection
Re-binds to the auth store with the credentials of the user you logged in
sub ldap_connection {
my $self = shift;
$self->store->ldap_bind( undef, $self->ldap_entry->dn,
- $self->_ldap_connection_password->() );
+ $_ldap_connection_passwords{refaddr($self)} );
}
=head2 AUTOLOADed methods
$c->user->homedirectory
And you'll get the value of the "homeDirectory" attribute. Note that
-all the AUTOLOADed methods are automatically lower-cased.
+all the AUTOLOADed methods are automatically lower-cased.
=head2 Special Keywords
The highly useful and common method "username" will map to the configured
-value of user_field (uid by default.)
+value of user_field (uid by default.)
$c->user->username == $c->user->uid
=cut
+sub DESTROY {
+ my $self = shift;
+ # Don't leak passwords..
+ delete $_ldap_connection_passwords{refaddr($self)};
+}
+
+sub can {
+ my ($self, $method) = @_;
+
+ return $self->SUPER::can($method) || do {
+ return unless $self->has_attribute($method);
+ return sub { $_[0]->has_attribute($method) };
+ };
+}
+
sub AUTOLOAD {
my $self = shift;
if ( $method eq "DESTROY" ) {
return;
}
- if ( exists( $self->user->{'attributes'}->{$method} ) ) {
- return $self->user->{'attributes'}->{$method};
- }
- elsif ( $method eq "username" ) {
- my $userfield = $self->store->user_field;
- my $username = $self->has_attribute($userfield);
- if ($username) {
- return $username;
- }
- else {
- Catalyst::Exception->throw( "User is missing the "
- . $userfield
- . " attribute, which should not be possible!" );
- }
+
+ if ( my $attribute = $self->has_attribute($method) ) {
+ return $attribute;
}
else {
Catalyst::Exception->throw(
Adam Jacob <holoway@cpan.org>
Some parts stolen shamelessly and entirely from
-L<Catalyst::Plugin::Authentication::Store::Htpasswd>.
+L<Catalyst::Plugin::Authentication::Store::Htpasswd>.
Currently maintained by Peter Karman <karman@cpan.org>.
projects / catagits/Catalyst-Authentication-Store-LDAP.git / blobdiff