X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAuthentication%2FStore%2FLDAP%2FUser.pm;h=e0b6e7f9b70fa7cebdacf7afd8654b767c654a85;hb=HEAD;hp=d63c7651ad1bc082d5c3decc61e1435040e9c34f;hpb=821627ad45646d20b53dcb3e8568f77e743265b8;p=catagits%2FCatalyst-Authentication-Store-LDAP.git diff --git a/lib/Catalyst/Authentication/Store/LDAP/User.pm b/lib/Catalyst/Authentication/Store/LDAP/User.pm index d63c765..e0b6e7f 100644 --- a/lib/Catalyst/Authentication/Store/LDAP/User.pm +++ b/lib/Catalyst/Authentication/Store/LDAP/User.pm @@ -4,7 +4,7 @@ =head1 NAME Catalyst::Authentication::Store::LDAP::User - - A User object representing an LDAP object. + - A User object representing an LDAP object. =head1 SYNOPSIS @@ -25,13 +25,13 @@ username. =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 @@ -48,13 +48,18 @@ use base qw( Catalyst::Authentication::User Class::Accessor::Fast ); use strict; use warnings; +use Scalar::Util qw/refaddr/; +use Net::LDAP::Entry; -our $VERSION = '1.006'; +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) @@ -70,11 +75,11 @@ Returns a L object. =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 @@ -107,8 +112,8 @@ sub stringify { return $string; } else { - my ($string) = $self->$userfield; - return $string; + my $val = $self->$userfield; + return ref($val) eq 'ARRAY' ? $val->[0] : $val; } } @@ -136,20 +141,9 @@ bind, 0 on failure. 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 { @@ -165,25 +159,40 @@ Returns the results of L's "look 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 @@ -213,7 +222,7 @@ sub attributes { =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 @@ -226,6 +235,9 @@ sub has_attribute { 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}; } @@ -234,6 +246,23 @@ sub has_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 @@ -244,7 +273,7 @@ as, and returns a L object which you can use to do further queries. 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 @@ -275,17 +304,32 @@ You can call: $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; @@ -294,20 +338,9 @@ sub AUTOLOAD { 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( @@ -324,7 +357,7 @@ __END__ Adam Jacob Some parts stolen shamelessly and entirely from -L. +L. Currently maintained by Peter Karman .