[Catalyst-commits] r7431 - in Catalyst-Authentication-Store-LDAP: .
trunk trunk/lib trunk/lib/Catalyst trunk/lib/Catalyst/Authentication
trunk/lib/Catalyst/Authentication/Store
trunk/lib/Catalyst/Authentication/Store/LDAP trunk/t trunk/t/lib
karpet at dev.catalyst.perl.org
karpet at dev.catalyst.perl.org
Tue Feb 5 15:20:45 GMT 2008
Author: karpet
Date: 2008-02-05 15:20:42 +0000 (Tue, 05 Feb 2008)
New Revision: 7431
Added:
Catalyst-Authentication-Store-LDAP/branches/
Catalyst-Authentication-Store-LDAP/tags/
Catalyst-Authentication-Store-LDAP/trunk/
Catalyst-Authentication-Store-LDAP/trunk/Changes
Catalyst-Authentication-Store-LDAP/trunk/MANIFEST
Catalyst-Authentication-Store-LDAP/trunk/MANIFEST.SKIP
Catalyst-Authentication-Store-LDAP/trunk/META.yml
Catalyst-Authentication-Store-LDAP/trunk/Makefile.PL
Catalyst-Authentication-Store-LDAP/trunk/TODO
Catalyst-Authentication-Store-LDAP/trunk/lib/
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
Catalyst-Authentication-Store-LDAP/trunk/t/
Catalyst-Authentication-Store-LDAP/trunk/t/02-realms_api.t
Catalyst-Authentication-Store-LDAP/trunk/t/03-entry_class.t
Catalyst-Authentication-Store-LDAP/trunk/t/lib/
Catalyst-Authentication-Store-LDAP/trunk/t/lib/EntryClass.pm
Catalyst-Authentication-Store-LDAP/trunk/t/lib/LDAPTest.pm
Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t
Catalyst-Authentication-Store-LDAP/trunk/t/pod.t
Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl
Log:
rename from ::Plugin and refactor tests
Added: Catalyst-Authentication-Store-LDAP/trunk/Changes
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/Changes (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/Changes 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,42 @@
+0.1000 4 Feb 2008
+ - forked from Catalyst::Plugin::Authentication::Store::LDAP and name changed
+ to Catalyst::Authentication::Store::LDAP
+ - tests now use Net::LDAP::Server::Test instead of relying on openldap.org
+ - changed release date for 0.0600
+ - added AD config suggestions from matija at serverflow.com
+ - bumped req base Auth package to 0.10003
+
+
+0.0600 karman 18 Oct 2007 [was: omega Thu Aug 09 09:22:00 CET 2007]
+ - Someone had put some 0.052 version out, need to bump past that
+ - Add realms API support to match newest C::P::Authentication API. (karman)
+ - Add POD tests. (karman)
+
+0.06 omega Thu Aug 09 09:00:00 CET 2007
+ - Added support for entry_class in the same way that Catalyst::Model::LDAP
+ supports it, allowing one to override what class is returned from
+ $c->user->ldap_entry, and thus allowing one to add methods to the user
+ object
+
+0.05
+ - Added support for multiple identifiers.
+
+0.04 adam Tue Mar 21 15:31:57 PST 2006
+ - Fixed rt.cpan.org #18250, sample YAML config incorrectly using arrays
+ - Added some error checking around whether or not we have been properly
+ configured.
+
+0.03 adam Fri Feb 17 09:51:36 PST 2006
+ - Gavin Henry's documentation patch for YAML configuration
+
+0.02 adam Fri Feb 10 14:10:23 PST 2006
+ - Now throws an exception if the initial bind fails
+ - Changed the default role_filter from (member=%s) to (memberUid=%s)
+ - Fixed bug in Backend->lookup_user that was not properly handling
+ when a user was not found in the backing store at all.
+
+0.01 adam Thu Feb 8 14:28:18 2006
+ - initial revision
+ - supports authentication
+ - supports roles
+
Added: Catalyst-Authentication-Store-LDAP/trunk/MANIFEST
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/MANIFEST (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/MANIFEST 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,25 @@
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/Catalyst/Authentication/Store/LDAP.pm
+lib/Catalyst/Authentication/Store/LDAP/Backend.pm
+lib/Catalyst/Authentication/Store/LDAP/User.pm
+Makefile.old
+Makefile.PL
+MANIFEST This list of files
+META.yml
+t/02-realms_api.t
+t/03-entry_class.t
+t/lib/EntryClass.pm
+t/lib/LDAPTest.pm
+t/pod-coverage.t
+t/pod.t
Added: Catalyst-Authentication-Store-LDAP/trunk/MANIFEST.SKIP
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/MANIFEST.SKIP (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/MANIFEST.SKIP 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,6 @@
+.svn
+^Makefile$
+^blib/
+^.*\.swp$
+^MANIFEST\.
+^pm_to_blib$
\ No newline at end of file
Added: Catalyst-Authentication-Store-LDAP/trunk/META.yml
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/META.yml (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/META.yml 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,22 @@
+---
+abstract: Authenticate Users against LDAP Directories
+author:
+ - Adam Jacob <holoway at cpan.org>
+build_requires:
+ Net::LDAP::Server::Test: 0.02
+ Test::More: 0
+distribution_type: module
+generated_by: Module::Install version 0.68
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: Catalyst-Authentication-Store-LDAP
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ Catalyst::Plugin::Authentication: 0.10003
+ Net::LDAP: 0
+version: 0.1000
Added: Catalyst-Authentication-Store-LDAP/trunk/Makefile.PL
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/Makefile.PL (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/Makefile.PL 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,19 @@
+use inc::Module::Install;
+
+name('Catalyst-Authentication-Store-LDAP');
+abstract('Authenticate Users against LDAP Directories');
+author('Adam Jacob <holoway at cpan.org>');
+version_from('lib/Catalyst/Authentication/Store/LDAP.pm');
+license('perl');
+
+requires('Net::LDAP');
+requires( 'Catalyst::Plugin::Authentication' => '0.10003' );
+
+#requires('Catalyst::Model::LDAP');
+build_requires('Net::LDAP::Server::Test' => '0.02');
+build_requires('Test::More');
+
+auto_install();
+
+&WriteAll;
+
Added: Catalyst-Authentication-Store-LDAP/trunk/TODO
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/TODO (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/TODO 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,6 @@
+* Cache - this hits the directory a lot during full Auth/Authz usage.
+
+* Recipes - We could handle some default recipes in the documentation for
+ different usage patterns.
+
+* Tests - We don't do any but the most cursory of tests
Added: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/Backend.pm 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,458 @@
+
+=pod
+
+=head1 NAME
+
+Catalyst::Authentication::Store::LDAP::Backend
+ - LDAP authentication storage backend.
+
+=head1 SYNOPSIS
+
+ # you probably just want Store::LDAP under most cases,
+ # but if you insist you can instantiate your own store:
+
+ use Catalyst::Authentication::Store::LDAP::Backend;
+
+ use Catalyst qw/
+ Authentication
+ Authentication::Credential::Password
+ /;
+
+ my %config = (
+ 'ldap_server' => 'ldap1.yourcompany.com',
+ 'ldap_server_options' => {
+ 'timeout' => 30,
+ },
+ 'binddn' => 'anonymous',
+ 'bindpw' => 'dontcarehow',
+ 'start_tls' => 1,
+ 'start_tls_options' => {
+ 'verify' => 'none',
+ },
+ 'user_basedn' => 'ou=people,dc=yourcompany,dc=com',
+ 'user_filter' => '(&(objectClass=posixAccount)(uid=%s))',
+ 'user_scope' => 'one',
+ 'user_field' => 'uid',
+ 'user_search_options' => {
+ 'deref' => 'always',
+ },
+ 'entry_class' => 'MyApp::LDAP::Entry',
+ 'use_roles' => 1,
+ 'role_basedn' => 'ou=groups,dc=yourcompany,dc=com',
+ 'role_filter' => '(&(objectClass=posixGroup)(member=%s))',
+ 'role_scope' => 'one',
+ 'role_field' => 'cn',
+ 'role_value' => 'dn',
+ 'role_search_options' => {
+ 'deref' => 'always',
+ },
+ );
+
+ our $users = Catalyst::Authentication::Store::LDAP::Backend->new(\%config);
+
+ sub action : Local {
+ my ( $self, $c ) = @_;
+
+ $c->login( $users->get_user( $c->req->param("login") ),
+ $c->req->param("password") );
+ }
+
+=head1 DESCRIPTION
+
+You probably want L<Catalyst::Authentication::Store::LDAP>, unless
+you are mixing several stores in a single app and one of them is LDAP.
+
+Otherwise, this lets you create a store manually.
+
+See the L<Catalyst::Authentication::Store::LDAP> documentation for
+an explanation of the configuration options.
+
+=head1 METHODS
+
+=cut
+
+package Catalyst::Authentication::Store::LDAP::Backend;
+use base qw( Class::Accessor::Fast );
+
+use strict;
+use warnings;
+
+our $VERSION = '0.1000';
+
+use Catalyst::Authentication::Store::LDAP::User;
+use Net::LDAP;
+
+BEGIN {
+ __PACKAGE__->mk_accessors(
+ qw( ldap_server ldap_server_options binddn
+ bindpw entry_class user_search_options
+ user_filter user_basedn user_scope
+ user_attrs user_field use_roles role_basedn
+ role_filter role_scope role_field role_value
+ role_search_options start_tls start_tls_options
+ )
+ );
+}
+
+=head2 new($config)
+
+Creates a new L<Catalyst::Authentication::Store::LDAP::Backend> object.
+$config should be a hashref, which should contain the configuration options
+listed in L<Catalyst::Authentication::Store::LDAP>'s documentation.
+
+Also sets a few sensible defaults.
+
+=cut
+
+sub new {
+ my ( $class, $config ) = @_;
+
+ unless ( defined($config) && ref($config) eq "HASH" ) {
+ Catalyst::Exception->throw(
+ "Catalyst::Authentication::Store::LDAP::Backend needs to be configured with a hashref."
+ );
+ }
+ my %config_hash = %{$config};
+ $config_hash{'binddn'} ||= 'anonymous';
+ $config_hash{'user_filter'} ||= '(uid=%s)';
+ $config_hash{'user_scope'} ||= 'sub';
+ $config_hash{'user_field'} ||= 'uid';
+ $config_hash{'role_filter'} ||= '(memberUid=%s)';
+ $config_hash{'role_scope'} ||= 'sub';
+ $config_hash{'role_field'} ||= 'cn';
+ $config_hash{'use_roles'} ||= '1';
+ $config_hash{'start_tls'} ||= '0';
+ $config_hash{'entry_class'} ||= 'Catalyst::Model::LDAP::Entry';
+
+ my $self = \%config_hash;
+ bless( $self, $class );
+ return $self;
+}
+
+=head2 find_user( I<authinfo> )
+
+Creates a L<Catalyst::Authentication::Store::LDAP::User> object
+for the given User ID. This is the preferred mechanism for getting a
+given User out of the Store.
+
+I<authinfo> should be a hashref with a key of either C<id> or
+C<username>. The value will be compared against the LDAP C<user_field> field.
+
+=cut
+
+sub find_user {
+ my ( $self, $authinfo, $c ) = @_;
+ return $self->get_user( $authinfo->{id} || $authinfo->{username} );
+}
+
+=head2 get_user($id)
+
+Creates a L<Catalyst::Authentication::Store::LDAP::User> object
+for the given User ID. This is the preferred mechanism for getting a
+given User out of the Store.
+
+=cut
+
+sub get_user {
+ my ( $self, $id ) = @_;
+ my $user = Catalyst::Authentication::Store::LDAP::User->new( $self,
+ $self->lookup_user($id) );
+ return $user;
+}
+
+=head2 ldap_connect
+
+Returns a L<Net::LDAP> object, connected to your LDAP server. (According
+to how you configured the Backend, of course)
+
+=cut
+
+sub ldap_connect {
+ my ($self) = shift;
+ my $ldap;
+ if ( defined( $self->ldap_server_options() ) ) {
+ $ldap
+ = Net::LDAP->new( $self->ldap_server,
+ %{ $self->ldap_server_options } )
+ or Catalyst::Exception->throw($@);
+ }
+ else {
+ $ldap = Net::LDAP->new( $self->ldap_server )
+ or Catalyst::Exception->throw($@);
+ }
+ if ( defined( $self->start_tls ) && $self->start_tls =~ /(1|true)/i ) {
+ my $mesg;
+ if ( defined( $self->start_tls_options ) ) {
+ $mesg = $ldap->start_tls( %{ $self->start_tls_options } );
+ }
+ else {
+ $mesg = $ldap->start_tls;
+ }
+ if ( $mesg->is_error ) {
+ Catalyst::Exception->throw( "TLS Error: " . $mesg->error );
+ }
+ }
+ return $ldap;
+}
+
+=head2 ldap_bind($ldap, $binddn, $bindpw)
+
+Bind's to the directory. If $ldap is undef, it will connect to the
+LDAP server first. $binddn should be the DN of the object you wish
+to bind as, and $bindpw the password.
+
+If $binddn is "anonymous", an anonymous bind will be performed.
+
+=cut
+
+sub ldap_bind {
+ my ( $self, $ldap, $binddn, $bindpw, $forauth ) = @_;
+ $forauth ||= 0;
+ $ldap ||= $self->ldap_connect;
+ if ( !defined($ldap) ) {
+ Catalyst::Exception->throw("LDAP Server undefined!");
+ }
+ $binddn ||= $self->binddn;
+ $bindpw ||= $self->bindpw;
+ if ( $binddn eq "anonymous" ) {
+ my $mesg = $ldap->bind;
+ if ( $mesg->is_error ) {
+ Catalyst::Exception->throw( "Error on Bind: " . $mesg->error );
+ }
+ }
+ else {
+ if ($bindpw) {
+ my $mesg = $ldap->bind( $binddn, 'password' => $bindpw );
+ if ( $mesg->is_error ) {
+
+ # If we're not checking this bind for authentication purposes
+ # Go ahead an blow up if we fail.
+ if ( $forauth ne 'forauth' ) {
+ Catalyst::Exception->throw(
+ "Error on Initial Bind: " . $mesg->error );
+ }
+ else {
+ return undef;
+ }
+ }
+ }
+ else {
+ my $mesg = $ldap->bind($binddn);
+ if ( $mesg->is_error ) {
+ return undef;
+ }
+ }
+ }
+ return $ldap;
+}
+
+=head2 lookup_user($id)
+
+Given a User ID, this method will:
+
+ A) Bind to the directory using the configured binddn and bindpw
+ B) Perform a search for the User Object in the directory, using
+ user_basedn, user_filter, and user_scope.
+ C) Assuming we found the object, we will walk it's attributes
+ using L<Net::LDAP::Entry>'s get_value method. We store the
+ results in a hashref.
+ D) Return a hashref that looks like:
+
+ $results = {
+ 'ldap_entry' => $entry, # The Net::LDAP::Entry object
+ 'attributes' => $attributes,
+ }
+
+This method is usually only called by get_user.
+
+=cut
+
+sub lookup_user {
+ my ( $self, $id ) = @_;
+
+ # No sneaking in wildcards!
+ if ( $id =~ /\*/ ) {
+ Catalyst::Exception->throw("ID $id contains wildcards!");
+ }
+ my $ldap = $self->ldap_bind;
+ my @searchopts;
+ if ( defined( $self->user_basedn ) ) {
+ push( @searchopts, 'base' => $self->user_basedn );
+ }
+ else {
+ Catalyst::Exception->throw(
+ "You must set user_basedn before looking up users!");
+ }
+ my $filter = $self->_replace_filter( $self->user_filter, $id );
+ push( @searchopts, 'filter' => $filter );
+ push( @searchopts, 'scope' => $self->user_scope );
+ if ( defined( $self->user_search_options ) ) {
+ push( @searchopts, %{ $self->user_search_options } );
+ }
+ my $usersearch = $ldap->search(@searchopts);
+ if ( $usersearch->is_error ) {
+ Catalyst::Exception->throw(
+ "LDAP Error while searching for user: " . $usersearch->error );
+ }
+ my $userentry;
+ my $user_field = $self->user_field;
+ my @user_fields
+ = ref $user_field eq 'ARRAY' ? @$user_field : ($user_field);
+
+ # TODO check for multiple matches, which we should really not have.
+RESULT: while ( my $entry = $usersearch->pop_entry ) {
+ foreach my $field (@user_fields) {
+ foreach my $value ( $entry->get_value($field) ) {
+ if ( $value eq $id ) {
+ $userentry = $entry;
+ last RESULT;
+ }
+ }
+ }
+ }
+ $ldap->unbind;
+ $ldap->disconnect;
+ unless ($userentry) {
+ return undef;
+ }
+ my $attrhash;
+ foreach my $attr ( $userentry->attributes ) {
+ my @attrvalues = $userentry->get_value($attr);
+ if ( scalar(@attrvalues) == 1 ) {
+ $attrhash->{ lc($attr) } = $attrvalues[0];
+ }
+ else {
+ $attrhash->{ lc($attr) } = \@attrvalues;
+ }
+ }
+ my $load_class = $self->entry_class . ".pm";
+ $load_class =~ s|::|/|g;
+
+ eval { require $load_class };
+ if ( !$@ ) {
+ bless( $userentry, $self->entry_class );
+ $userentry->{_use_unicode}++;
+ }
+ my $rv = {
+ 'ldap_entry' => $userentry,
+ 'attributes' => $attrhash,
+ };
+ return $rv;
+}
+
+=head2 lookup_roles($userobj)
+
+This method looks up the roles for a given user. It takes a
+L<Catalyst::Authentication::Store::LDAP::User> object
+as it's sole argument.
+
+It returns an array containing the role_field attribute from all the
+objects that match it's criteria.
+
+=cut
+
+sub lookup_roles {
+ my ( $self, $userobj ) = @_;
+ if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) {
+ return undef;
+ }
+ my $ldap = $self->ldap_bind;
+ my @searchopts;
+ if ( defined( $self->role_basedn ) ) {
+ push( @searchopts, 'base' => $self->role_basedn );
+ }
+ else {
+ Catalyst::Exception->throw(
+ "You must set up role_basedn before looking up roles!");
+ }
+ my $filter_value = $userobj->has_attribute( $self->role_value );
+ if ( !defined($filter_value) ) {
+ Catalyst::Exception->throw( "User object "
+ . $userobj->username
+ . " has no "
+ . $self->role_value
+ . " attribute, so I can't look up it's roles!" );
+ }
+ my $filter = $self->_replace_filter( $self->role_filter, $filter_value );
+ push( @searchopts, 'filter' => $filter );
+ push( @searchopts, 'scope' => $self->role_scope );
+ push( @searchopts, 'attrs' => [ $self->role_field ] );
+ if ( defined( $self->role_search_options ) ) {
+ push( @searchopts, %{ $self->role_search_options } );
+ }
+ my $rolesearch = $ldap->search(@searchopts);
+ my @roles;
+RESULT: while ( my $entry = $rolesearch->pop_entry ) {
+ my ($role) = $entry->get_value( $self->role_field );
+ if ($role) {
+ push( @roles, $role );
+ }
+ else {
+ next RESULT;
+ }
+ }
+ return @roles;
+}
+
+sub _replace_filter {
+ my $self = shift;
+ my $filter = shift;
+ my $replace = shift;
+ $filter =~ s/\%s/$replace/g;
+ return $filter;
+}
+
+=head2 user_supports
+
+Returns the value of
+Catalyst::Authentication::Store::LDAP::User->supports(@_).
+
+=cut
+
+sub user_supports {
+ my $self = shift;
+
+ # this can work as a class method
+ Catalyst::Authentication::Store::LDAP::User->supports(@_);
+}
+
+=head2 from_session( I<id> )
+
+Returns get_user() for I<id>.
+
+=cut
+
+sub from_session {
+ my ( $self, $c, $id ) = @_;
+ $self->get_user($id);
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS
+
+Adam Jacob <holoway at cpan.org>
+
+Some parts stolen shamelessly and entirely from
+L<Catalyst::Plugin::Authentication::Store::Htpasswd>.
+
+Currently maintained by Peter Karman <karman at cpan.org>.
+
+=head1 THANKS
+
+To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :)
+
+=head1 SEE ALSO
+
+L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::User>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2005 the aforementioned authors. All rights
+reserved. This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+=cut
+
Added: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP/User.pm 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,316 @@
+
+=pod
+
+=head1 NAME
+
+Catalyst::Authentication::Store::LDAP::User
+ - A User object representing an LDAP object.
+
+=head1 SYNOPSIS
+
+You should be creating these objects through L<Catalyst::Authentication::Store::LDAP::Backend>'s "get_user" method, or just letting $c->login do
+it for you.
+
+ sub action : Local {
+ my ( $self, $c ) = @_;
+ $c->login($c->req->param(username), $c->req->param(password));
+ $c->log->debug($c->user->username . "is really neat!");
+ }
+
+If you access just $c->user in a scalar context, it will return the current
+username.
+
+=head1 DESCRIPTION
+
+This wraps up an LDAP object and presents a simplified interface to it's
+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.
+
+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",
+discussed in more detail below.
+
+You can skip all that and just go straight to the L<Net::LDAP::Entry>
+object through the "ldap_entry" method:
+
+ my $entry = $c->user->ldap_entry;
+
+It also has support for Roles.
+
+=cut
+
+package Catalyst::Authentication::Store::LDAP::User;
+use base qw( Catalyst::Authentication::User Class::Accessor::Fast );
+
+use strict;
+use warnings;
+
+our $VERSION = '0.1000';
+
+BEGIN { __PACKAGE__->mk_accessors(qw/user store/) }
+
+use overload '""' => sub { shift->stringify }, fallback => 1;
+
+=head1 METHODS
+
+=head2 new($store, $user)
+
+Takes a L<Catalyst::Authentication::Store::LDAP::Backend> object
+as $store, and the data structure returned by that class's "get_user"
+method as $user.
+
+Returns a L<Catalyst::Authentication::Store::LDAP::User> object.
+
+=cut
+
+sub new {
+ my ( $class, $store, $user ) = @_;
+
+ return unless $user;
+
+ bless { store => $store, user => $user, }, $class;
+}
+
+=head2 id
+
+Returns the results of the "stringify" method.
+
+=cut
+
+sub id {
+ my $self = shift;
+ return $self->stringify;
+}
+
+=head2 stringify
+
+Uses the "user_field" configuration option to determine what the "username"
+of this object is, and returns it.
+
+If you use the special value "dn" for user_field, it will return the DN
+of the L<Net::LDAP::Entry> object.
+
+=cut
+
+sub stringify {
+ my ($self) = @_;
+ my $userfield = $self->store->user_field;
+ $userfield = $$userfield[0] if ref $userfield eq 'ARRAY';
+ if ( $userfield eq "dn" ) {
+ my ($string) = $self->user->ldap_entry->dn;
+ return $string;
+ }
+ else {
+ my ($string) = $self->$userfield;
+ return $string;
+ }
+}
+
+=head2 supported_features
+
+Returns hashref of features that this Authentication::User subclass supports.
+
+=cut
+
+sub supported_features {
+ return {
+ password => { self_check => 1, },
+ session => 1,
+ roles => { self_check => 0, },
+ };
+}
+
+=head2 check_password($password)
+
+Bind's to the directory as the DN of the internal L<Net::LDAP::Entry> object,
+using the bind password supplied in $password. Returns 1 on a successful
+bind, 0 on failure.
+
+=cut
+
+sub check_password {
+ my ( $self, $password ) = @_;
+ my $ldap
+ = $self->store->ldap_bind( undef, $self->ldap_entry->dn, $password,
+ 'forauth' );
+ if ( defined($ldap) ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+=head2 roles
+
+Returns the results of L<Catalyst::Authentication::Store::LDAP::Backend>'s "lookup_roles" method, an array of roles that are valid for this user.
+
+=cut
+
+sub roles {
+ my $self = shift;
+ return $self->store->lookup_roles($self);
+}
+
+=head2 for_session
+
+Returns the User object, stringified.
+
+=cut
+
+sub for_session {
+ my $self = shift;
+ return $self->stringify;
+}
+
+=head2 ldap_entry
+
+Returns the raw ldap_entry.
+
+=cut
+
+sub ldap_entry {
+ my $self = shift;
+ return $self->user->{'ldap_entry'};
+}
+
+=head2 attributes($type)
+
+Returns an array of attributes present for this user. If $type is "ashash",
+it will return a hash with the attribute names as keys. (And the values of
+those attributes as, well, the values of the hash)
+
+=cut
+
+sub attributes {
+ my ( $self, $type ) = @_;
+ if ( $type eq "ashash" ) {
+ return $self->user->{'attributes'};
+ }
+ else {
+ return keys( %{ $self->user->{'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.
+
+=cut
+
+sub has_attribute {
+ my ( $self, $attribute ) = @_;
+ if ( !defined($attribute) ) {
+ Catalyst::Exception->throw(
+ "You must provide an attribute to has_attribute!");
+ }
+ if ( $attribute eq "dn" ) {
+ return $self->ldap_entry->dn;
+ }
+ elsif ( exists( $self->user->{'attributes'}->{$attribute} ) ) {
+ return $self->user->{'attributes'}->{$attribute};
+ }
+ else {
+ return undef;
+ }
+}
+
+=head2 AUTOLOADed methods
+
+We automatically map the attributes of the underlying L<Net::LDAP::Entry>
+object to read-only accessor methods. So, if you have an entry that looks
+like this one:
+
+ dn: cn=adam,ou=users,dc=yourcompany,dc=com
+ cn: adam
+ loginShell: /bin/zsh
+ homeDirectory: /home/adam
+ gecos: Adam Jacob
+ gidNumber: 100
+ uidNumber: 1053
+ mail: adam at yourcompany.com
+ uid: adam
+ givenName: Adam
+ sn: Jacob
+ objectClass: inetOrgPerson
+ objectClass: organizationalPerson
+ objectClass: Person
+ objectClass: Top
+ objectClass: posixAccount
+
+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.
+
+=head2 Special Keywords
+
+The highly useful and common method "username" will map to the configured
+value of user_field (uid by default.)
+
+ $c->user->username == $c->user->uid
+
+=cut
+
+sub AUTOLOAD {
+ my $self = shift;
+
+ ( my $method ) = ( our $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!" );
+ }
+ }
+ else {
+ Catalyst::Exception->throw(
+ "No attribute $method for User " . $self->stringify );
+ }
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS
+
+Adam Jacob <holoway at cpan.org>
+
+Some parts stolen shamelessly and entirely from
+L<Catalyst::Plugin::Authentication::Store::Htpasswd>.
+
+Currently maintained by Peter Karman <karman at cpan.org>.
+
+=head1 THANKS
+
+To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :)
+
+=head1 SEE ALSO
+
+L<Catalyst::Authentication::Store::LDAP>, L<Catalyst::Authentication::Store::LDAP::Backend>, L<Catalyst::Plugin::Authentication>, L<Net::LDAP>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2005 the aforementioned authors. All rights
+reserved. This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+=cut
+
Added: Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/lib/Catalyst/Authentication/Store/LDAP.pm 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,320 @@
+package Catalyst::Authentication::Store::LDAP;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.1000';
+
+use Catalyst::Authentication::Store::LDAP::Backend;
+
+sub new {
+ my ( $class, $config, $app ) = @_;
+ return Catalyst::Authentication::Store::LDAP::Backend->new(
+ $config);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Authentication::Store::LDAP
+ - Authentication from an LDAP Directory.
+
+=head1 SYNOPSIS
+
+ use Catalyst qw/
+ Authentication
+ Authentication::Store::LDAP
+ Authentication::Credential::Password
+ /;
+
+ __PACKAGE__->config(
+ 'authentication' => {
+ default_realm => "ldap",
+ realms => {
+ ldap => {
+ credential => {
+ class => "Password",
+ password_field => "password",
+ password_type => "self_check",
+ },
+ store => {
+ binddn => "anonymous",
+ bindpw => "dontcarehow",
+ class => "LDAP",
+ ldap_server => "ldap.yourcompany.com",
+ ldap_server_options => { timeout => 30 },
+ role_basedn => "ou=groups,ou=OxObjects,dc=yourcompany,dc=com",
+ role_field => "uid",
+ role_filter => "(&(objectClass=posixGroup)(memberUid=%s))",
+ role_scope => "one",
+ role_search_options => { deref => "always" },
+ role_value => "dn",
+ start_tls => 1,
+ start_tls_options => { verify => "none" },
+ entry_class => "MyApp::LDAP::Entry",
+ use_roles => 1,
+ user_basedn => "ou=people,dc=yourcompany,dc=com",
+ user_field => "uid",
+ user_filter => "(&(objectClass=posixAccount)(uid=%s))",
+ user_scope => "one",
+ user_search_options => { deref => "always" },
+ },
+ },
+ },
+ },
+ );
+
+ sub login : Global {
+ my ( $self, $c ) = @_;
+
+ $c->authenticate({
+ id => $c->req->param("login"),
+ password => $c->req->param("password")
+ });
+ $c->res->body("Welcome " . $c->user->username . "!");
+ }
+
+=head1 DESCRIPTION
+
+This plugin implements the L<Catalyst::Authentication> v.10 API. Read that documentation first if
+you are upgrading from a previous version of this plugin.
+
+This plugin uses C<Net::LDAP> to let your application authenticate against
+an LDAP directory. It has a pretty high degree of flexibility, given the
+wide variation of LDAP directories and schemas from one system to another.
+
+It authenticates users in two steps:
+
+1) A search of the directory is performed, looking for a user object that
+ matches the username you pass. This is done with the bind credentials
+ supplied in the "binddn" and "bindpw" configuration options.
+
+2) If that object is found, we then re-bind to the directory as that object.
+ Assuming this is successful, the user is Authenticated.
+
+=head1 CONFIGURATION OPTIONS
+
+=head2 Configuring with YAML
+
+Set Configuration to be loaded via Config.yml in YourApp.pm
+
+ use YAML qw(LoadFile);
+ use Path::Class 'file';
+
+ __PACKAGE__->config(
+ LoadFile(
+ file(__PACKAGE__->config->{home}, 'Config.yml')
+ )
+ );
+
+Settings in Config.yml (adapt these to whatever configuration format you use):
+
+ # Config for Store::LDAP
+ authentication:
+ default_realm: ldap
+ realms:
+ ldap:
+ credential:
+ class: Password
+ password_field: password
+ password_type: self_check
+ store:
+ class: LDAP
+ ldap_server: ldap.yourcompany.com
+ ldap_server_options:
+ timeout: 30
+ binddn: anonymous
+ bindpw: dontcarehow
+ start_tls: 1
+ start_tls_options:
+ verify: none
+ user_basedn: ou=people,dc=yourcompany,dc=com
+ user_filter: (&(objectClass=posixAccount)(uid=%s))
+ user_scope: one
+ user_field: uid
+ user_search_options:
+ deref: always
+ use_roles: 1
+ role_basedn: ou=groups,ou=OxObjects,dc=yourcompany,dc=com
+ role_filter: (&(objectClass=posixGroup)(memberUid=%s))
+ role_scope: one
+ role_field: uid
+ role_value: dn
+ role_search_options:
+ deref: always
+
+
+B<NOTE:> The settings above reflect the default values for OpenLDAP. If you
+are using Active Directory instead, Matija Grabnar suggests that the following
+tweeks to the example configuration will work:
+
+ user_basedn: ou=Domain Users,ou=Accounts,dc=mycompany,dc=com
+ user_field: samaccountname
+ user_filter: (sAMAccountName=%s)
+
+He also notes: "I found the case in the value of user_field to be significant:
+it didn't seem to work when I had the mixed case value there."
+
+=head2 ldap_server
+
+This should be the hostname of your LDAP server.
+
+=head2 ldap_server_options
+
+This should be a hashref containing options to pass to L<Net::LDAP>->new().
+See L<Net::LDAP> for the full list.
+
+=head2 binddn
+
+This should be the DN of the object you wish to bind to the directory as
+during the first phase of authentication. (The user lookup phase)
+
+If you supply the value "anonymous" to this option, we will bind anonymously
+to the directory. This is the default.
+
+=head2 bindpw
+
+This is the password for the initial bind.
+
+=head2 start_tls
+
+If this is set to 1, we will convert the LDAP connection to use SSL.
+
+=head2 start_tls_options
+
+This is a hashref, which contains the arguments to the L<Net::LDAP> start_tls
+method. See L<Net::LDAP> for the complete list of options.
+
+=head2 user_basedn
+
+This is the basedn for the initial user lookup. Usually points to the
+top of your "users" branch; ie "ou=people,dc=yourcompany,dc=com".
+
+=head2 user_filter
+
+This is the LDAP Search filter used during user lookup. The special string
+'%s' will be replaced with the username you pass to $c->login. By default
+it is set to '(uid=%s)'. Other possibly useful filters:
+
+ (&(objectClass=posixAccount)(uid=%s))
+ (&(objectClass=User)(cn=%s))
+
+=head2 user_scope
+
+This specifies the scope of the search for the initial user lookup. Valid
+values are "base", "one", and "sub". Defaults to "sub".
+
+=head2 user_field
+
+This is the attribute of the returned LDAP object we will use for their
+"username". This defaults to "uid". If you had user_filter set to:
+
+ (&(objectClass=User)(cn=%s))
+
+You would probably set this to "cn". You can also set it to an array,
+to allow more than one login field. The first field will be returned
+as identifier for the user.
+
+=head2 user_search_options
+
+This takes a hashref. It will append it's values to the call to
+L<Net::LDAP>'s "search" method during the initial user lookup. See
+L<Net::LDAP> for valid options.
+
+Be careful not to specify:
+
+ filter
+ scope
+ base
+
+As they are already taken care of by other configuration options.
+
+=head2 use_roles
+
+Whether or not to enable role lookups. It defaults to true; set it to 0 if
+you want to always avoid role lookups.
+
+=head2 role_basedn
+
+This should be the basedn where the LDAP Objects representing your roles are.
+
+=head2 role_filter
+
+This should be the LDAP Search filter to use during the role lookup. It
+defaults to '(memberUid=%s)'. The %s in this filter is replaced with the value
+of the "role_value" configuration option.
+
+So, if you had a role_value of "cn", then this would be populated with the cn
+of the User's LDAP object. The special case is a role_value of "dn", which
+will be replaced with the User's DN.
+
+=head2 role_scope
+
+This specifies the scope of the search for the user's role lookup. Valid
+values are "base", "one", and "sub". Defaults to "sub".
+
+=head2 role_field
+
+Should be set to the Attribute of the Role Object's returned during Role lookup you want to use as the "name" of the role. Defaults to "CN".
+
+=head2 role_value
+
+This is the attribute of the User object we want to use in our role_filter.
+If this is set to "dn", we will use the User Objects DN.
+
+=head2 role_search_options
+
+This takes a hashref. It will append it's values to the call to
+L<Net::LDAP>'s "search" method during the user's role lookup. See
+L<Net::LDAP> for valid options.
+
+Be careful not to specify:
+
+ filter
+ scope
+ base
+
+As they are already taken care of by other configuration options.
+
+=head1 METHODS
+
+=head2 new
+
+This method will populate
+L<Catalyst::Plugin::Authentication/default_auth_store> with this object.
+
+=head1 AUTHORS
+
+Adam Jacob <holoway at cpan.org>
+
+Some parts stolen shamelessly and entirely from
+L<Catalyst::Plugin::Authentication::Store::Htpasswd>.
+
+Currently maintained by Peter Karman <karman at cpan.org>.
+
+=head1 THANKS
+
+To nothingmuch, ghenry, castaway and the rest of #catalyst for the help. :)
+
+=head1 SEE ALSO
+
+L<Catalyst::Authentication::Store::LDAP>,
+L<Catalyst::Authentication::Store::LDAP::User>,
+L<Catalyst::Authentication::Store::LDAP::Backend>,
+L<Catalyst::Plugin::Authentication>,
+L<Net::LDAP>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2005 the aforementioned authors. All rights
+reserved. This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+
Added: Catalyst-Authentication-Store-LDAP/trunk/t/02-realms_api.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/02-realms_api.t (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/02-realms_api.t 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Catalyst::Exception;
+
+use Test::More tests => 5;
+use lib 't/lib';
+use LDAPTest;
+my $server = LDAPTest::spawn_server();
+
+use_ok("Catalyst::Authentication::Store::LDAP::Backend");
+
+my $back = Catalyst::Authentication::Store::LDAP::Backend->new(
+ { 'ldap_server' => LDAPTest::server_host(),
+
+ # can test the timeout SKIP with this
+ 'ldap_server_options' =>
+ { timeout => -1, debug => $ENV{PERL_DEBUG} || 0 },
+
+ 'binddn' => 'anonymous',
+ 'bindpw' => 'dontcarehow',
+ 'start_tls' => 0,
+ 'user_basedn' => 'ou=foobar',
+ 'user_filter' => '(&(objectClass=person)(uid=%s))',
+ 'user_scope' => 'one',
+ 'user_field' => 'uid',
+ 'use_roles' => 0,
+ }
+);
+
+isa_ok( $back, "Catalyst::Authentication::Store::LDAP::Backend" );
+ok( my $user = $back->find_user( { username => 'somebody' } ), "find_user" );
+isa_ok( $user, "Catalyst::Authentication::Store::LDAP::User" );
+my $displayname = $user->displayname;
+cmp_ok( $displayname, 'eq', 'Some Body', 'Should be Some Body' );
+
Added: Catalyst-Authentication-Store-LDAP/trunk/t/03-entry_class.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/03-entry_class.t (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/03-entry_class.t 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Catalyst::Exception;
+
+use Test::More tests => 6;
+use lib 't/lib';
+use LDAPTest;
+my $server = LDAPTest::spawn_server();
+
+SKIP: {
+
+ eval "use Catalyst::Model::LDAP";
+ if ($@) {
+ skip "Catalyst::Model::LDAP not installed", 6;
+ }
+
+ use_ok("Catalyst::Authentication::Store::LDAP::Backend");
+
+ my $back = Catalyst::Authentication::Store::LDAP::Backend->new(
+ { 'ldap_server' => LDAPTest::server_host(),
+ 'binddn' => 'anonymous',
+ 'bindpw' => 'dontcarehow',
+ 'start_tls' => 0,
+ 'user_basedn' => 'ou=foobar',
+ 'user_filter' => '(&(objectClass=person)(uid=%s))',
+ 'user_scope' => 'one',
+ 'user_field' => 'uid',
+ 'use_roles' => 0,
+ 'entry_class' => 'EntryClass',
+ }
+ );
+
+ isa_ok( $back, "Catalyst::Authentication::Store::LDAP::Backend" );
+ my $user = $back->find_user( { username => 'somebody' } );
+ isa_ok( $user, "Catalyst::Authentication::Store::LDAP::User" );
+ my $displayname = $user->displayname;
+ cmp_ok( $displayname, 'eq', 'Some Body', 'Should be Some Body' );
+
+ isa_ok( $user->ldap_entry, "EntryClass", "entry_class works" );
+ is( $user->ldap_entry->my_method, 1001, "methods on entry_class works" );
+
+}
Added: Catalyst-Authentication-Store-LDAP/trunk/t/lib/EntryClass.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/lib/EntryClass.pm (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/lib/EntryClass.pm 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,8 @@
+package EntryClass;
+
+use base qw( Catalyst::Model::LDAP::Entry );
+
+sub my_method {
+ return 1001;
+}
+1;
Added: Catalyst-Authentication-Store-LDAP/trunk/t/lib/LDAPTest.pm
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/lib/LDAPTest.pm (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/lib/LDAPTest.pm 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,26 @@
+# local test ldap server
+
+package LDAPTest;
+
+use Net::LDAP::Server::Test;
+use Net::LDAP::Entry;
+
+sub server_port {10636}
+sub server_host { 'ldap://127.0.0.1:' . server_port() }
+
+sub spawn_server {
+ my @mydata;
+ my $entry = Net::LDAP::Entry->new;
+ $entry->dn('ou=foobar');
+ $entry->add(
+ dn => 'ou=foobar',
+ uid => 'somebody',
+ displayName => 'Some Body',
+ cn => [qw(value1 value2)]
+ );
+ push @mydata, $entry;
+
+ return Net::LDAP::Server::Test->new( server_port(), \@mydata );
+}
+
+1;
Added: Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/pod-coverage.t 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: Catalyst-Authentication-Store-LDAP/trunk/t/pod.t
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/pod.t (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/pod.t 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Added: Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl
===================================================================
--- Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl (rev 0)
+++ Catalyst-Authentication-Store-LDAP/trunk/t/sane.pl 2008-02-05 15:20:42 UTC (rev 7431)
@@ -0,0 +1,93 @@
+
+use Test::More tests => 12;
+use Carp;
+use Net::LDAP;
+use Net::LDAP::Server::Test;
+use Net::LDAP::Entry;
+
+#
+# these tests pulled nearly verbatim from the Net::LDAP synopsis
+#
+
+my %opts = (
+ port => '10636',
+ dnc => 'ou=internal,dc=foo',
+ debug => $ENV{PERL_DEBUG} || 0,
+);
+
+my $host = 'ldap://localhost:' . $opts{port};
+
+ok( my $server = Net::LDAP::Server::Test->new( $opts{port} ),
+ "spawn new server" );
+
+ok( my $ldap = Net::LDAP->new( $host, %opts, ), "new LDAP connection" );
+
+unless ($ldap) {
+ croak "Unable to connect to LDAP server $host: $@";
+}
+
+ok( my $rc = $ldap->bind(), "LDAP bind()" );
+
+ok( my $mesg = $ldap->search( # perform a search
+ base => "c=US",
+ filter => "(&(sn=Barr) (o=Texas Instruments))"
+ ),
+ "LDAP search()"
+);
+
+$mesg->code && croak $mesg->error;
+
+my $count = 0;
+foreach my $entry ( $mesg->entries ) {
+
+ #$entry->dump;
+ $count++;
+}
+
+is( $count, 13, "$count entries found in search" );
+
+ok( $mesg = $ldap->unbind, "LDAP unbind()" );
+
+#warn "unbind done";
+
+my @mydata;
+my $entry = Net::LDAP::Entry->new;
+$entry->dn('ou=foobar');
+$entry->add(
+ dn => 'ou=foobar',
+ sn => 'value1',
+ cn => [qw(value1 value2)]
+);
+push @mydata, $entry;
+
+ok( $server = Net::LDAP::Server::Test->new( $opts{port}, \@mydata ),
+ "spawn new server with our own data" );
+
+ok( $ldap = Net::LDAP->new( $host, %opts, ), "new LDAP connection" );
+
+unless ($ldap) {
+ croak "Unable to connect to LDAP server $host: $@";
+}
+
+ok( $rc = $ldap->bind(), "LDAP bind()" );
+
+ok( $mesg = $ldap->search( # perform a search
+ base => "c=US",
+ filter => "(&(sn=Barr) (o=Texas Instruments))"
+ ),
+ "LDAP search()"
+);
+
+$mesg->code && croak $mesg->error;
+
+$count = 0;
+foreach my $entry ( $mesg->entries ) {
+
+ $entry->dump;
+ $count++;
+}
+
+is( $count, 1, "$count entries found in search" );
+
+ok( $mesg = $ldap->unbind, "LDAP unbind()" );
+
More information about the Catalyst-commits
mailing list