Test-Net-LDAP-0.07/000755 000765 000024 00000000000 12504313664 014247 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/Changes000644 000765 000024 00000001401 12504313614 015531 0ustar00mahirostaff000000 000000 Revision history for Test-Net-LDAP 0.07 2015-03-25 Bugfix: Handle (attrs => ['*']) correctly in search. TODO: Support operational attributes 0.06 2015-03-24 Support arbitrary Net::LDAP subclasses. Bugfix for default scope in search (should be subtree). 0.05 2015-03-18 Bugfix with case-insensitive DN Add mock_target to normalize scheme://host:port 0.04 2014-08-03 Add mock_bind and mock_password https://github.com/mahiro/perl-Test-Net-LDAP/issues/1 0.03 2014-07-19 Support array ref as the hostnames for Net::LDAP->new() https://rt.cpan.org/Ticket/Display.html?id=96932 0.02 2013-07-07 Add support for root_dse 0.01 2013-01-06 Initial version Test-Net-LDAP-0.07/lib/000755 000765 000024 00000000000 12504313664 015015 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/Makefile.PL000644 000765 000024 00000001160 12502003676 016214 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::Net::LDAP', AUTHOR => q{Mahiro Ando }, VERSION_FROM => 'lib/Test/Net/LDAP.pm', ABSTRACT_FROM => 'lib/Test/Net/LDAP.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'Net::LDAP' => '0.52', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Test-Net-LDAP-*' }, ); Test-Net-LDAP-0.07/MANIFEST000644 000765 000024 00000001154 12504313664 015401 0ustar00mahirostaff000000 000000 Changes lib/Test/Net/LDAP.pm lib/Test/Net/LDAP/Mixin.pm lib/Test/Net/LDAP/Mock.pm lib/Test/Net/LDAP/Mock/Data.pm lib/Test/Net/LDAP/Mock/Node.pm lib/Test/Net/LDAP/Util.pm Makefile.PL MANIFEST README t/00-load.t t/01-methods.t t/10-util.t t/11-mockify.t t/12-test-names.t t/20-mock-node.t t/21-mock-search.t t/22-mock-add.t t/23-mock-modify.t t/24-mock-delete.t t/25-mock-moddn.t t/26-mock-compare.t t/27-mock-bind.t t/28-mock-target.t t/30-mock-other.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Test-Net-LDAP-0.07/META.json000644 000765 000024 00000001620 12504313664 015667 0ustar00mahirostaff000000 000000 { "abstract" : "A Net::LDAP subclass for testing", "author" : [ "Mahiro Ando " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-Net-LDAP", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Net::LDAP" : "0.52", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "0.07" } Test-Net-LDAP-0.07/META.yml000644 000765 000024 00000001010 12504313664 015510 0ustar00mahirostaff000000 000000 --- abstract: 'A Net::LDAP subclass for testing' author: - 'Mahiro Ando ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Net-LDAP no_index: directory: - t - inc requires: Net::LDAP: '0.52' Test::More: '0' version: '0.07' Test-Net-LDAP-0.07/README000644 000765 000024 00000002762 12502055117 015130 0ustar00mahirostaff000000 000000 Test-Net-LDAP Test::Net::LDAP is a subclass of Net::LDAP and provides testing methods for LDAP operations, such as search, add, and modify, where each method is suffixed with either _ok or _is. (E.g. search_ok and search_is) Test::Net::LDAP::Mock is a subclass of Test::Net::LDAP and performs all the LDAP operations in memory without connecting to the real LDAP server, so that it is easy to set up fake LDAP entries for particular test cases. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Test::Net::LDAP You can also look for information at: GitHub repository (report bugs here) https://github.com/mahiro/perl-Test-Net-LDAP RT, CPAN's request tracker (report bugs here, alternatively) http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Net-LDAP AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Test-Net-LDAP CPAN Ratings http://cpanratings.perl.org/d/Test-Net-LDAP Search CPAN http://search.cpan.org/dist/Test-Net-LDAP/ LICENSE AND COPYRIGHT Copyright (C) 2013-2015 Mahiro Ando This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Test-Net-LDAP-0.07/t/000755 000765 000024 00000000000 12504313664 014512 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/t/00-load.t000644 000765 000024 00000000317 12502003676 016031 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 1; BEGIN { use_ok( 'Test::Net::LDAP' ) || print "Bail out!\n"; } diag( "Testing Test::Net::LDAP $Test::Net::LDAP::VERSION, Perl $], $^X" ); Test-Net-LDAP-0.07/t/01-methods.t000644 000765 000024 00000001513 12502003676 016555 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 18; use Test::Net::LDAP; use Test::Net::LDAP::Mock; use Test::Net::LDAP::Mock::Data; ok(Test::Net::LDAP->can('search_ok')); ok(Test::Net::LDAP->can('compare_ok')); ok(Test::Net::LDAP->can('add_ok')); ok(Test::Net::LDAP->can('modify_ok')); ok(Test::Net::LDAP->can('delete_ok')); ok(Test::Net::LDAP->can('moddn_ok')); ok(Test::Net::LDAP->can('bind_ok')); ok(Test::Net::LDAP->can('unbind_ok')); ok(Test::Net::LDAP->can('abandon_ok')); ok(Test::Net::LDAP->can('search_is')); ok(Test::Net::LDAP->can('compare_is')); ok(Test::Net::LDAP->can('add_is')); ok(Test::Net::LDAP->can('modify_is')); ok(Test::Net::LDAP->can('delete_is')); ok(Test::Net::LDAP->can('moddn_is')); ok(Test::Net::LDAP->can('bind_is')); ok(Test::Net::LDAP->can('unbind_is')); ok(Test::Net::LDAP->can('abandon_is')); Test-Net-LDAP-0.07/t/10-util.t000644 000765 000024 00000001766 12502003676 016101 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 8; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS ); use Test::Net::LDAP::Mock; use Test::Net::LDAP::Util qw( ldap_result_ok ldap_result_is ); # Result - status code only ldap_result_ok(LDAP_SUCCESS); ldap_result_is(LDAP_NO_SUCH_OBJECT, LDAP_NO_SUCH_OBJECT); # Result - message object my $ldap = Test::Net::LDAP::Mock->new; my $mesg = $ldap->message('Net::LDAP::Message' => {}); $mesg->{resultCode} = LDAP_SUCCESS; ldap_result_ok($mesg); $mesg = $ldap->message('Net::LDAP::Message' => {}); $mesg->{resultCode} = LDAP_ALREADY_EXISTS; ldap_result_is($mesg, LDAP_ALREADY_EXISTS); # Export { package TestPackage1; use Test::Net::LDAP::Util qw(ldap_result_is); } ok(TestPackage1->can('ldap_result_is')); ok(!TestPackage1->can('ldap_result_ok')); { package TestPackage2; use Test::Net::LDAP::Util qw(:all); } ok(TestPackage2->can('ldap_result_is')); ok(TestPackage2->can('ldap_result_ok')); Test-Net-LDAP-0.07/t/11-mockify.t000644 000765 000024 00000014562 12504223052 016556 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 51; use Net::LDAP; use Test::Net::LDAP::Util qw(ldap_mockify ldap_dn_is); ldap_mockify { # ldap1 for my $ldap (Net::LDAP->new('ldap1.example.com')) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user01, dc=example, dc=com'); $ldap->add('uid=user02, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user01,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user02,dc=example,dc=com'; } # ldap2 for my $ldap (Net::LDAP->new('ldap2.example.com')) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user03, dc=example, dc=com'); $ldap->add('uid=user04, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user03,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user04,dc=example,dc=com'; } # ldap1, port 3389 for my $ldap (Net::LDAP->new('ldap1.example.com', port => 3389)) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user05, dc=example, dc=com'); $ldap->add('uid=user06, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user05,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user06,dc=example,dc=com'; } # ldap1, ldaps for my $ldap (Net::LDAP->new('ldap1.example.com', scheme => 'ldaps')) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user07, dc=example, dc=com'); $ldap->add('uid=user08, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user07,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user08,dc=example,dc=com'; } # /tmp/ldap1, ldapi for my $ldap (Net::LDAP->new('/tmp/ldap1', scheme => 'ldapi')) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user09, dc=example, dc=com'); $ldap->add('uid=user10, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user09,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user10,dc=example,dc=com'; } # /tmp/ldap2, ldapi for my $ldap (Net::LDAP->new('/tmp/ldap2', scheme => 'ldapi')) { is ref($ldap), 'Test::Net::LDAP::Mock'; $ldap->add('uid=user11, dc=example, dc=com'); $ldap->add('uid=user12, dc=example, dc=com'); my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user11,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user12,dc=example,dc=com'; } }; ldap_mockify { # ldap1 (again) for my $ldap (Net::LDAP->new('ldap1.example.com')) { is ref($ldap), 'Test::Net::LDAP::Mock'; my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user01,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user02,dc=example,dc=com'; } }; ldap_mockify { # Net::LDAP->new() can take an array ref as hostnames. # In that case, the first one should be used. for my $ldap (Net::LDAP->new(['ldap1.example.com', 'ldap2.example.com'])) { is ref($ldap), 'Test::Net::LDAP::Mock'; my $search = $ldap->search_ok(scope => 'sub', filter => '(uid=*)'); is scalar($search->entries), 2; my $entries = [sort {$a->dn cmp $b->dn} $search->entries]; ldap_dn_is $entries->[0]->dn, 'uid=user01,dc=example,dc=com'; ldap_dn_is $entries->[1]->dn, 'uid=user02,dc=example,dc=com'; } }; # Net::LDAP subclasses { package Net::LDAP::MySubclass1; use base 'Net::LDAP'; sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{__subclass_test} = ref($self).'::new called'; return $self; } sub search { my $self = shift; my $mesg = $self->SUPER::search(@_); $mesg->{__subclass_test} = ref($self).'::search called'; return $mesg; } package Net::LDAP::MySubclass2; use base 'Net::LDAP::MySubclass1'; sub my_method { my ($self) = @_; return ref($self).'::my_method called'; } } ok !'Net::LDAP::MySubclass1'->isa('Test::Net::LDAP::Mock'); ldap_mockify { Net::LDAP::MySubclass1->new('subclass1.example.com'); ok 'Net::LDAP::MySubclass1'->isa('Test::Net::LDAP::Mock'); do { my $ldap = Net::LDAP::MySubclass1->new('subclass1.example.com'); is($ldap->{__subclass_test}, 'Net::LDAP::MySubclass1::new called'); $ldap->add_ok('uid=subclass1, dc=example, dc=com'); my $mesg = $ldap->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => 'uid=subclass1', ); is($mesg->{__subclass_test}, 'Net::LDAP::MySubclass1::search called'); is($mesg->count, 1); }; do { my $ldap = Net::LDAP::MySubclass2->new('subclass2.example.com'); is($ldap->{__subclass_test}, 'Net::LDAP::MySubclass2::new called'); is($ldap->my_method, 'Net::LDAP::MySubclass2::my_method called'); }; }; ok !'Net::LDAP::MySubclass1'->isa('Test::Net::LDAP::Mock'); ok 'Net::LDAP::MySubclass2'->isa('Net::LDAP::MySubclass1'); Test-Net-LDAP-0.07/t/12-test-names.t000644 000765 000024 00000002476 12502003676 017205 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 4; use Net::LDAP::Constant qw( LDAP_ALREADY_EXISTS ); use Test::Builder; use Test::Net::LDAP::Mock; sub test_name_is(&$) { my ($callback, $expected) = @_; my $last_name; { no warnings 'redefine'; local *Test::Builder::ok = sub { my ($self, $test, $name) = @_; $last_name = $name; }; local *Test::Builder::diag = sub {}; $callback->(); } local $Test::Builder::Level = $Test::Builder::Level + 1; is $last_name, $expected; } my $ldap = Test::Net::LDAP::Mock->new; test_name_is { $ldap->method_ok('search', base => 'dc=example, dc=com'); } 'search(base => "dc=example, dc=com")'; test_name_is { $ldap->method_ok('search', [ base => 'dc=example, dc=com', scope => 'sub', filter => '(uid=*)', attrs => [qw(uid cn)], ]); } qq{search(base => "dc=example, dc=com", scope => "sub", filter => "(uid=*)")}; test_name_is { $ldap->method_ok('add', 'uid=user, dc=example, dc=com'); } qq{add(dn => "uid=user, dc=example, dc=com")}; test_name_is { $ldap->method_is('add', [ dn => 'uid=user, dc=example, dc=com', attrs => [cn => 'User'], ], LDAP_ALREADY_EXISTS); } qq{add(dn => "uid=user, dc=example, dc=com")}; Test-Net-LDAP-0.07/t/20-mock-node.t000644 000765 000024 00000003065 12502004331 016760 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 25; use Test::Net::LDAP::Mock::Node; ok my $root = Test::Net::LDAP::Mock::Node->new; is($root->get_node({dc => 'com'}), undef); ok my $com = $root->make_node({dc => 'com'}); cmp_ok($root->get_node({dc => 'com'}), '==', $com); cmp_ok($root->get_node([{dc => 'com'}]), '==', $com); cmp_ok($root->get_node('dc=com'), '==', $com); is($com->get_node({dc => 'example'}), undef); ok my $example = $com->make_node({dc => 'example'}); cmp_ok($com->get_node({dc => 'example'}), '==', $example); cmp_ok($root->get_node([{dc => 'example'}, {dc => 'com'}]), '==', $example); cmp_ok($root->get_node('dc=example, dc=com'), '==', $example); ok my $example2 = $com->make_node('dc=example'); cmp_ok($example, '==', $example2); cmp_ok($com->get_node('dc=example'), '==', $example2); cmp_ok($root->get_node('dc=example, dc=com'), '==', $example2); ok my $foobar = $root->make_node('cn=foo+uid=bar, dc=example, dc=com'); cmp_ok($example->get_node({cn => 'foo', uid => 'bar'}), '==', $foobar); cmp_ok($root->get_node([{cn => 'foo', uid => 'bar'}, {dc => 'example'}, {dc => 'com'}]), '==', $foobar); cmp_ok($root->get_node('cn=foo+uid=bar, dc=example, dc=com'), '==', $foobar); cmp_ok($root->get_node('uid=bar+cn=foo, dc=example, dc=com'), '==', $foobar); is($root->get_node('cn=foo, dc=example, dc=com'), undef); is($root->get_node('uid=bar, dc=example, dc=com'), undef); # DN is case-insensitive ok my $example3 = $com->make_node('DC=Example'); cmp_ok($example, '==', $example3); cmp_ok($root->get_node('Dc=EXAMPLE,dC=Com'), '==', $example); Test-Net-LDAP-0.07/t/21-mock-search.t000644 000765 000024 00000014333 12504313353 017312 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 91; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_NO_SUCH_OBJECT LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX ); use Test::Net::LDAP::Mock::Data; use Test::Net::LDAP::Util qw(ldap_dn_is); my $data = Test::Net::LDAP::Mock::Data->new; my $search; my $entries; my $attrs; # Prepare entries $data->add_ok('uid=user1, ou=abc, dc=example, dc=com', attrs => [ cn => 'foo', sn => 'user', ]); $data->add_ok('uid=user2, ou=abc, dc=example, dc=com', attrs => [ cn => 'bar', sn => 'user', ]); $data->add_ok('uid=user3, ou=def, dc=example, dc=com', attrs => [ cn => 'foo', sn => 'user', ]); $data->add_ok('uid=user4, ou=def, dc=example, dc=com', attrs => [ cn => 'bar', sn => 'user', ]); # scope => 'base' $search = $data->search_ok( base => 'uid=user1, ou=abc, dc=example, dc=com', scope => 'base' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 1); is(scalar(@$entries), 1); ldap_dn_is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com'); # scope => 'one' $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 2); is(scalar(@$entries), 2); ldap_dn_is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com'); ldap_dn_is($entries->[1]->dn, 'uid=user2,ou=abc,dc=example,dc=com'); $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one', filter => '(cn=bar)' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 1); is(scalar(@$entries), 1); ldap_dn_is($entries->[0]->dn, 'uid=user2,ou=abc,dc=example,dc=com'); # scope => 'sub' $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'sub' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 4); is(scalar(@$entries), 4); ldap_dn_is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com'); ldap_dn_is($entries->[1]->dn, 'uid=user2,ou=abc,dc=example,dc=com'); ldap_dn_is($entries->[2]->dn, 'uid=user3,ou=def,dc=example,dc=com'); ldap_dn_is($entries->[3]->dn, 'uid=user4,ou=def,dc=example,dc=com'); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'sub', filter => '(cn=bar)' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 2); is(scalar(@$entries), 2); ldap_dn_is($entries->[0]->dn, 'uid=user2,ou=abc,dc=example,dc=com'); ldap_dn_is($entries->[1]->dn, 'uid=user4,ou=def,dc=example,dc=com'); # Default scope => 'sub' $search = $data->search_ok( base => 'dc=example, dc=com', filter => '(cn=bar)', ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 2); is(scalar(@$entries), 2); ldap_dn_is($entries->[0]->dn, 'uid=user2,ou=abc,dc=example,dc=com'); ldap_dn_is($entries->[1]->dn, 'uid=user4,ou=def,dc=example,dc=com'); # All attributes (attrs => undef) $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one', filter => '(uid=user1)' ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 1); is(scalar(@$entries), 1); ldap_dn_is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com'); $attrs = [sort $entries->[0]->attributes]; is(scalar(@$attrs), 3); is($attrs->[0], 'cn'); is($attrs->[1], 'sn'); is($attrs->[2], 'uid'); is($entries->[0]->get_value('cn'), 'foo'); is($entries->[0]->get_value('sn'), 'user'); is($entries->[0]->get_value('uid'), 'user1'); # All attributes (attrs => []) $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [] ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; $attrs = [sort $entries->[0]->attributes]; is(scalar(@$attrs), 3); is($attrs->[0], 'cn'); is($attrs->[1], 'sn'); is($attrs->[2], 'uid'); is($entries->[0]->get_value('cn'), 'foo'); is($entries->[0]->get_value('sn'), 'user'); is($entries->[0]->get_value('uid'), 'user1'); # All attributes (attrs => ['*']) $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => ['*'] ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; $attrs = [sort $entries->[0]->attributes]; is(scalar(@$attrs), 3); is($attrs->[0], 'cn'); is($attrs->[1], 'sn'); is($attrs->[2], 'uid'); is($entries->[0]->get_value('cn'), 'foo'); is($entries->[0]->get_value('sn'), 'user'); is($entries->[0]->get_value('uid'), 'user1'); # Limited attributes $search = $data->search_ok( base => 'ou=abc, dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(cn sn)], ); $entries = [sort {$a->dn cmp $b->dn} $search->entries]; is($search->count, 1); is(scalar(@$entries), 1); ldap_dn_is($entries->[0]->dn, 'uid=user1,ou=abc,dc=example,dc=com'); $attrs = [sort $entries->[0]->attributes]; is(scalar(@$attrs), 2); is($attrs->[0], 'cn'); is($attrs->[1], 'sn'); is($entries->[0]->get_value('cn'), 'foo'); is($entries->[0]->get_value('sn'), 'user'); is($entries->[0]->get_value('uid'), undef); # Callback my @callback_args; $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'sub', filter => '(cn=foo)', attrs => [qw(cn sn)], callback => sub { push @callback_args, \@_; }, ); is(scalar(@callback_args), 3); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $search); is(scalar(@{$callback_args[1]}), 2); cmp_ok($callback_args[1][0], '==', $search); is($callback_args[1][1]->get_value('cn'), 'foo'); is(scalar(@{$callback_args[2]}), 2); cmp_ok($callback_args[2][0], '==', $search); is($callback_args[2][1]->get_value('cn'), 'foo'); # Error: base dn is invalid $data->search_is([base => 'invalid'], LDAP_INVALID_DN_SYNTAX); $data->search_is([base => ''], LDAP_SUCCESS); $data->search_is([base => undef], LDAP_SUCCESS); # Error: scope is invalid $data->search_is([scope => 'invalid'], LDAP_PARAM_ERROR); $data->search_is([scope => 3], LDAP_PARAM_ERROR); $data->search_is([scope => 0], LDAP_SUCCESS); # Error: filter is invalid $data->search_is([filter => 'invalid'], LDAP_PARAM_ERROR); $data->search_is([filter => ''], LDAP_SUCCESS); $data->search_is([filter => undef], LDAP_SUCCESS); # Error: base dn does not exist $data->search_is([ base => 'ou=invalid, dc=example, dc=com', scope => 'one', ], LDAP_NO_SUCH_OBJECT); Test-Net-LDAP-0.07/t/22-mock-add.t000644 000765 000024 00000005570 12502053747 016607 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 35; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_ALREADY_EXISTS ); use Net::LDAP::Entry; use Net::LDAP::Util qw(canonical_dn); use Test::Net::LDAP::Mock::Data; use Test::Net::LDAP::Util qw(ldap_result_is ldap_dn_is); my $data = Test::Net::LDAP::Mock::Data->new; my $search; # Add an entry $data->add_ok('uid=user1, dc=example, dc=com', attrs => [ sn => 'User', cn => 'One', ]); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid sn cn)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is($search->entry->get_value('uid'), 'user1'); is($search->entry->get_value('sn'), 'User'); is($search->entry->get_value('cn'), 'One'); # Add more entries $data->add_ok('uid=user2, dc=example, dc=com', attrs => [ sn => 'User', cn => 'Two', ]); $data->add_ok('uid=user3, dc=example, dc=com', attrs => [ sn => 'User', cn => 'Three', ]); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid sn cn)], ); is(scalar($search->entries), 3); my @entries = sort {$a->get_value('uid') cmp $b->get_value('uid')} $search->entries; ldap_dn_is($entries[0]->dn, 'uid=user1,dc=example,dc=com'); is($entries[0]->get_value('uid'), 'user1'); is($entries[0]->get_value('sn'), 'User'); is($entries[0]->get_value('cn'), 'One'); ldap_dn_is($entries[1]->dn, 'uid=user2,dc=example,dc=com'); is($entries[1]->get_value('uid'), 'user2'); is($entries[1]->get_value('sn'), 'User'); is($entries[1]->get_value('cn'), 'Two'); ldap_dn_is($entries[2]->dn, 'uid=user3,dc=example,dc=com'); is($entries[2]->get_value('uid'), 'user3'); is($entries[2]->get_value('sn'), 'User'); is($entries[2]->get_value('cn'), 'Three'); # Callback my @callback_args; my $mesg = $data->add_ok('uid=user4, dc=example, dc=com', callback => sub { push @callback_args, \@_; } ); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Preserve DN exactly as specified at the time of add() $data->add_ok('UID=User5, DC=Example,DC=COM'); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user5)', attrs => [qw(uid)], ); is $search->entry->dn, 'UID=User5, DC=Example,DC=COM'; is $search->entry->get_value('uid'), 'User5'; # Error: dn is missing $data->add_is([attrs => [ cn => 'Test'] ], LDAP_PARAM_ERROR); # Error: dn is invalid $data->add_is(['invalid', attrs => [ cn => 'Test' ]], LDAP_INVALID_DN_SYNTAX); $data->add_is([dn => 'invalid', attrs => [ cn => 'Test' ]], LDAP_INVALID_DN_SYNTAX); # Error: Attempt to add a duplicate $data->add_is(['uid=user1, dc=example, dc=com', attrs => [ cn => 'Test' ]], LDAP_ALREADY_EXISTS); Test-Net-LDAP-0.07/t/23-mock-modify.t000644 000765 000024 00000015611 12502047505 017337 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 77; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT ); use Net::LDAP::Entry; use Test::Net::LDAP::Mock::Data; use Test::Net::LDAP::Util qw(ldap_dn_is); my $data = Test::Net::LDAP::Mock::Data->new; my $search; # Prepare entry $data->add_ok('uid=user1, dc=example, dc=com'); # Add attributes (1) $data->modify_ok('uid=user1, dc=example, dc=com', add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']} ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('myattr1')], ['value1.1']); is_deeply([$search->entry->get_value('myattr2')], ['value2.1', 'value2.2']); # Add attributes (2) $data->modify_ok('uid=user1, dc=example, dc=com', add => [myattr1 => ['value1.2'], myattr2 => 'value2.3'] ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('myattr1')], ['value1.1', 'value1.2']); is_deeply([$search->entry->get_value('myattr2')], ['value2.1', 'value2.2', 'value2.3']); # Replace attributes (1) $data->modify_ok('uid=user1, dc=example, dc=com', replace => {myattr2 => 'value2.4', myattr3 => ['value3.1', 'value3.2']} ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('myattr1')], ['value1.1', 'value1.2']); is_deeply([$search->entry->get_value('myattr2')], ['value2.4']); is_deeply([$search->entry->get_value('myattr3')], ['value3.1', 'value3.2']); # Replace attributes (2) $data->modify_ok('uid=user1, dc=example, dc=com', replace => [myattr3 => ['value3.3', 'value3.4'], myattr4 => 'value4.1'] ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('myattr1')], ['value1.1', 'value1.2']); is_deeply([$search->entry->get_value('myattr2')], ['value2.4']); is_deeply([$search->entry->get_value('myattr3')], ['value3.3', 'value3.4']); is_deeply([$search->entry->get_value('myattr4')], ['value4.1']); # Delete attributes (1) $data->modify_ok('uid=user1, dc=example, dc=com', delete => ['myattr1', 'myattr2'] ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is($search->entry->get_value('myattr1'), undef); is($search->entry->get_value('myattr2'), undef); is_deeply([$search->entry->get_value('myattr3')], ['value3.3', 'value3.4']); is_deeply([$search->entry->get_value('myattr4')], ['value4.1']); # Delete attributes (2) $data->modify_ok('uid=user1, dc=example, dc=com', delete => {myattr3 => ['value3.4'], myattr4 => []} ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(myattr1 myattr2 myattr3 myattr4)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is($search->entry->get_value('myattr1'), undef); is($search->entry->get_value('myattr2'), undef); is_deeply([$search->entry->get_value('myattr3')], ['value3.3']); is($search->entry->get_value('myattr4'), undef); # Increment attributes (1) $data->modify_ok('uid=user1, dc=example, dc=com', add => {mynum1 => 100, mynum2 => [200, 300]} ); $data->modify_ok('uid=user1, dc=example, dc=com', increment => {mynum1 => 22, mynum2 => 55} ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('mynum1')], [122]); is_deeply([$search->entry->get_value('mynum2')], [255, 355]); # Increment attributes (2) $data->modify_ok('uid=user1, dc=example, dc=com', increment => [mynum1 => -11, mynum2 => -22] ); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(mynum1 mynum2)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('mynum1')], [111]); is_deeply([$search->entry->get_value('mynum2')], [233, 333]); # Changes $data->modify_ok('uid=user1, dc=example, dc=com', add => { a1 => 'v1.1', r1 => ['v1.1', 'v1.2'], d1 => ['v1.1', 'v1.2'], d2 => ['v2.1', 'v2.2'], } ); $data->modify_ok('uid=user1, dc=example, dc=com', changes => [ add => [a1 => 'v1.2', a2 => 'v2.1'], replace => [r1 => 'v1.3', r2 => ['v2.1', 'v2.2']], delete => [d1 => 'v1.1', d2 => []], ]); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=user1)', attrs => [qw(a1 a2 r1 r2 d1 d2)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is_deeply([$search->entry->get_value('a1')], ['v1.1', 'v1.2']); is_deeply([$search->entry->get_value('a2')], ['v2.1']); is_deeply([$search->entry->get_value('r1')], ['v1.3']); is_deeply([$search->entry->get_value('r2')], ['v2.1', 'v2.2']); is_deeply([$search->entry->get_value('d1')], ['v1.2']); is_deeply([$search->entry->get_value('d2')], []); # Callback my @callback_args; my $mesg = $data->modify_ok('uid=user1, dc=example, dc=com', add => [ callback1 => 'value1', ], callback => sub { push @callback_args, \@_; } ); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Error: dn is missing $data->modify_is([ replace => [cn => 'Test'] ], LDAP_PARAM_ERROR); # Error: dn is invalid $data->modify_is(['invalid', replace => [cn => 'Test'] ], LDAP_INVALID_DN_SYNTAX); $data->modify_is([ dn => 'invalid', replace => [cn => 'Test'] ], LDAP_INVALID_DN_SYNTAX); # Error: change type is invalid $data->modify_is(['uid=user1, dc=example, dc=com', changes => [invalid => 'test'] ], LDAP_PARAM_ERROR); # Error: Attempt to modify an entry that does not exist $data->modify_is(['uid=nobody, dc=example, dc=com', add => {myattr1 => 'value1.1', myattr2 => ['value2.1', 'value2.2']} ], LDAP_NO_SUCH_OBJECT); Test-Net-LDAP-0.07/t/24-mock-delete.t000644 000765 000024 00000005670 12502047577 017330 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 35; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT ); use Net::LDAP::Entry; use Test::Net::LDAP::Mock::Data; use Test::Net::LDAP::Util qw(ldap_dn_is); my $data = Test::Net::LDAP::Mock::Data->new; my $search; my @entries; # Prepare user1, user2, user3 $data->add_ok('uid=user1, dc=example, dc=com', attrs => [ uid => 'user1', ]); $data->add_ok('uid=user2, dc=example, dc=com', attrs => [ uid => 'user2', ]); $data->add_ok('uid=user3, dc=example, dc=com', attrs => [ uid => 'user3', ]); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid)], ); is(scalar($search->entries), 3); @entries = sort {$a->get_value('uid') cmp $b->get_value('uid')} $search->entries; ldap_dn_is($entries[0]->dn, 'uid=user1,dc=example,dc=com'); is($entries[0]->get_value('uid'), 'user1'); ldap_dn_is($entries[1]->dn, 'uid=user2,dc=example,dc=com'); is($entries[1]->get_value('uid'), 'user2'); ldap_dn_is($entries[2]->dn, 'uid=user3,dc=example,dc=com'); is($entries[2]->get_value('uid'), 'user3'); # Delete user2 $data->delete_ok('uid=user2, dc=example, dc=com'); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid)], ); is(scalar($search->entries), 2); @entries = sort {$a->get_value('uid') cmp $b->get_value('uid')} $search->entries; ldap_dn_is($entries[0]->dn, 'uid=user1,dc=example,dc=com'); is($entries[0]->get_value('uid'), 'user1'); ldap_dn_is($entries[1]->dn, 'uid=user3,dc=example,dc=com'); is($entries[1]->get_value('uid'), 'user3'); # Delete user1 $data->delete_ok('uid=user1, dc=example, dc=com'); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); @entries = sort {$a->get_value('uid') cmp $b->get_value('uid')} $search->entries; ldap_dn_is($entries[0]->dn, 'uid=user3,dc=example,dc=com'); is($entries[0]->get_value('uid'), 'user3'); # Delete user3 $data->delete_ok('uid=user3, dc=example, dc=com'); $search = $data->search_ok( base => 'dc=example, dc=com', scope => 'one', filter => '(uid=*)', attrs => [qw(uid)], ); is(scalar($search->entries), 0); # Callback $data->add_ok('uid=cb1, dc=example, dc=com'); my @callback_args; my $mesg = $data->delete_ok('uid=cb1, dc=example, dc=com', callback => sub { push @callback_args, \@_; } ); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Error: dn is missing $data->delete_is([], LDAP_PARAM_ERROR); # Error: dn is invalid $data->delete_is(['invalid'], LDAP_INVALID_DN_SYNTAX); $data->delete_is([dn => 'invalid'], LDAP_INVALID_DN_SYNTAX); # Error: Attempt to delete an entry that does not exist $data->delete_is(['uid=invalid, dc=example, dc=com'], LDAP_NO_SUCH_OBJECT); Test-Net-LDAP-0.07/t/25-mock-moddn.t000644 000765 000024 00000007610 12502047657 017163 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 41; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS ); use Net::LDAP::Entry; use Test::Net::LDAP::Mock::Data; use Test::Net::LDAP::Util qw(ldap_dn_is); my $data = Test::Net::LDAP::Mock::Data->new; my $mesg; my $search; # Prepare entry $data->add_ok('uid=user1, dc=example, dc=com'); $search = $data->search_ok( base => 'dc=com', scope => 'sub', filter => '(uid=user*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user1,dc=example,dc=com'); is($search->entry->get_value('uid'), 'user1'); # newrdn $data->moddn_ok('uid=user1, dc=example, dc=com', newrdn => 'uid=user2', deleteoldrdn => 0, ); $search = $data->search_ok( base => 'dc=com', scope => 'sub', filter => '(uid=user*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user2,dc=example,dc=com'); is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user2']); # newrdn, deleteoldrdn $data->moddn_ok('uid=user2, dc=example, dc=com', newrdn => 'uid=user3', deleteoldrdn => 1, ); $search = $data->search_ok( base => 'dc=com', scope => 'sub', filter => '(uid=user*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user3,dc=example,dc=com'); is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user3']); # newsuperior $data->moddn_ok('uid=user3, dc=example, dc=com', newsuperior => 'dc=example2, dc=com', ); $search = $data->search_ok( base => 'dc=com', scope => 'sub', filter => '(uid=user*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user3,dc=example2,dc=com'); is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user3']); # newsuperior, newrdn $data->moddn_ok('uid=user3, dc=example2, dc=com', newsuperior => 'dc=example3, dc=com', newrdn => 'uid=user4', deleteoldrdn => 1, ); $search = $data->search_ok( base => 'dc=com', scope => 'sub', filter => '(uid=user*)', attrs => [qw(uid)], ); is(scalar($search->entries), 1); ldap_dn_is($search->entry->dn, 'uid=user4,dc=example3,dc=com'); is_deeply([sort $search->entry->get_value('uid')], ['user1', 'user4']); # Callback $data->add_ok('uid=cb1, dc=example, dc=com'); my @callback_args; $mesg = $data->modify_ok('uid=cb1, dc=example, dc=com', newrdn => 'uid=cb2', callback => sub { push @callback_args, \@_; } ); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Prepare entries for error cases $data->add_ok('uid=user1, dc=example1, dc=com'); $data->add_ok('uid=user2, dc=example1, dc=com'); $data->add_ok('uid=user2, dc=example2, dc=com'); # Error: dn is missing $data->moddn_is([ newrdn => 'uid=user2' ], LDAP_PARAM_ERROR); # Error: dn is invalid $data->moddn_is(['invalid', newrdn => 'uid=user2' ], LDAP_INVALID_DN_SYNTAX); $data->moddn_is([ dn => 'invalid', newrdn => 'uid=user2' ], LDAP_INVALID_DN_SYNTAX); # Error: newrdn is invalid $data->moddn_is([ dn => 'uid=user1, dc=example1, dc=com', newrdn => 'invalid' ], LDAP_INVALID_DN_SYNTAX); # Error: newsuperior is invalid $data->moddn_is([ dn => 'uid=user1, dc=example1, dc=com', newrdn => 'uid=user3', newsuperior => 'invalid', ], LDAP_INVALID_DN_SYNTAX); # Error: Attempt to modify an entry that does not exist $data->moddn_is(['uid=invalid, dc=example, dc=com', newrdn => 'uid=user1', ], LDAP_NO_SUCH_OBJECT); # Error: Attempt to move DN to an already existing destination $data->moddn_is(['uid=user1, dc=example1, dc=com', newrdn => 'uid=user2', ], LDAP_ALREADY_EXISTS); $data->moddn_is(['uid=user1, dc=example1, dc=com', newrdn => 'uid=user2', newsuperior => 'dc=example2, dc=com', ], LDAP_ALREADY_EXISTS); Test-Net-LDAP-0.07/t/26-mock-compare.t000644 000765 000024 00000003474 12502003676 017506 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 14; use Net::LDAP::Constant qw( LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE LDAP_PARAM_ERROR LDAP_INVALID_DN_SYNTAX LDAP_NO_SUCH_OBJECT ); use Test::Net::LDAP::Mock::Data; my $data = Test::Net::LDAP::Mock::Data->new; # Prepare data $data->add_ok('uid=compare1, ou=compare, dc=example, dc=com', attrs => [ cn => 'Compare 1' ]); # Compare $data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com', attr => 'uid', value => 'compare1', ], LDAP_COMPARE_TRUE); $data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com', attr => 'cn', value => 'Compare 1', ], LDAP_COMPARE_TRUE); $data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com', attr => 'cn', value => 'Compare 2', ], LDAP_COMPARE_FALSE); $data->compare_is(['uid=compare1, ou=compare, dc=example, dc=com', attr => 'sn', value => 'Compare 1', ], LDAP_COMPARE_FALSE); # Callback $data->add_ok('uid=cb1, dc=example, dc=com'); my @callback_args; my $mesg = $data->compare_is(['uid=cb1, dc=example, dc=com', attr => 'uid', value => 'cb1', callback => sub { push @callback_args, \@_; } ], LDAP_COMPARE_TRUE); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Error: dn is missing $data->compare_is([ attr => 'uid', value => 'compare1', ], LDAP_PARAM_ERROR); # Error: dn is invalid $data->compare_is(['invalid', attr => 'uid', value => 'compare1', ], LDAP_INVALID_DN_SYNTAX); $data->compare_is([ dn => 'invalid', attr => 'uid', value => 'compare1', ], LDAP_INVALID_DN_SYNTAX); # Error: Attempt to compare an entry that does not exist $data->modify_is(['uid=nobody, dc=example, dc=com', attr => 'uid', value => 'compare1', ], LDAP_NO_SUCH_OBJECT); Test-Net-LDAP-0.07/t/27-mock-bind.t000644 000765 000024 00000010467 12502003676 016775 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 47; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_NO_SUCH_OBJECT LDAP_INVALID_CREDENTIALS LDAP_INAPPROPRIATE_AUTH ); use Test::Net::LDAP::Mock::Data; my $data = Test::Net::LDAP::Mock::Data->new; $data->bind_ok(); # Set code only $data->mock_bind(LDAP_INVALID_CREDENTIALS); $data->bind_is([], LDAP_INVALID_CREDENTIALS); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); # Set code & message $data->mock_bind(LDAP_INVALID_CREDENTIALS, 'mock_bind error'); is($data->mock_bind(), LDAP_INVALID_CREDENTIALS); my $mesg = $data->bind(); is($mesg->code, LDAP_INVALID_CREDENTIALS); is($mesg->error, 'mock_bind error'); $data->mock_bind(LDAP_SUCCESS); is($data->mock_bind(), LDAP_SUCCESS); $data->bind_ok(); # Set Net::LDAP::Message my $mesg1 = bless({ type => 'Net::LDAP::Message', parent => undef, callback => undef, raw => undef, resultCode => LDAP_INVALID_CREDENTIALS, errorMessage => '', # empty errorMessage }, 'Net::LDAP::Message'); my $mesg2 = bless({ type => 'Net::LDAP::Message', parent => undef, callback => undef, raw => undef, resultCode => LDAP_INAPPROPRIATE_AUTH, errorMessage => 'Net::LDAP::Message error', }, 'Net::LDAP::Message'); $data->mock_bind($mesg1, ''); $mesg = $data->bind(); is($mesg->code, LDAP_INVALID_CREDENTIALS); is($mesg->error, 'Invalid credentials'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); $data->mock_bind($mesg1, 'mock_bind error'); $mesg = $data->bind(); is($mesg->code, LDAP_INVALID_CREDENTIALS); is($mesg->error, 'mock_bind error'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); $data->mock_bind($mesg2); $mesg = $data->bind(); is($mesg->code, LDAP_INAPPROPRIATE_AUTH); is($mesg->error, 'Net::LDAP::Message error'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); $data->mock_bind($mesg2, 'mock_bind error'); $mesg = $data->bind(); is($mesg->code, LDAP_INAPPROPRIATE_AUTH); is($mesg->error, 'mock_bind error'); # 2nd arg in mock_bind() has higher precedence $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); # Callback returning undef $data->mock_bind(sub { my ($arg) = @_; is($arg->{dn}, 'cn=test1'); is($arg->{password}, 'secret1'); return undef; }, 'mock_bind error'); $data->bind_ok('cn=test1', password => 'secret1'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); # Callback returning code only $data->mock_bind(sub { my ($arg) = @_; is($arg->{dn}, 'cn=test2'); is($arg->{password}, 'secret2'); return LDAP_INAPPROPRIATE_AUTH; }, 'mock_bind error'); $mesg = $data->bind('cn=test2', password => 'secret2'); is($mesg->code, LDAP_INAPPROPRIATE_AUTH); is($mesg->error, 'mock_bind error'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); # Callback returning code & message $data->mock_bind(sub { my ($arg) = @_; is($arg->{dn}, 'cn=test3'); is($arg->{password}, 'secret3'); return (LDAP_INAPPROPRIATE_AUTH, 'mock_bind callback error'); }, 'mock_bind error'); $mesg = $data->bind('cn=test3', password => 'secret3'); is($mesg->code, LDAP_INAPPROPRIATE_AUTH); is($mesg->error, 'mock_bind callback error'); $data->mock_bind(LDAP_SUCCESS); $data->bind_ok(); # Bind with password should succeed until some passwords are mocked is($data->mock_password('cn=test1, dc=example, dc=com'), undef); $data->bind_ok(); $data->bind_ok(['cn=test1,dc=example,dc=com', password => 'test1_password']); $data->bind_ok(['cn=test2,dc=example,dc=com', password => 'wrong_password']); $data->bind_ok(['cn=test3,dc=example,dc=com', password => 'any_password']); # Set passwords $data->mock_password('cn=test1, dc=example, dc=com' => 'test1_password'); $data->mock_password('cn=test2, dc=example, dc=com' => 'test2_password'); is($data->mock_password('cn=test1, dc=example, dc=com'), 'test1_password'); is($data->mock_password('cn=test2, dc=example, dc=com'), 'test2_password'); is($data->mock_password('cn=test3, dc=example, dc=com'), undef); $data->bind_ok(); # anonymous bind should succeed $data->bind_ok(['cn=test1,dc=example,dc=com', password => 'test1_password']); $data->bind_is(['cn=test2,dc=example,dc=com', password => 'wrong_password'], LDAP_INVALID_CREDENTIALS); $data->bind_is(['cn=test3,dc=example,dc=com', password => 'any_password'], LDAP_NO_SUCH_OBJECT); $data->bind_is([password => 'any_password'], LDAP_INAPPROPRIATE_AUTH); Test-Net-LDAP-0.07/t/28-mock-target.t000644 000765 000024 00000003632 12502041415 017335 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 12; use Test::Net::LDAP::Mock; do { Test::Net::LDAP::Mock->mock_target('ldap.example.com'); is(Test::Net::LDAP::Mock->mock_target(), 'ldap.example.com'); my $ldap1 = Test::Net::LDAP::Mock->new('ldap1.example.com'); my $ldap2 = Test::Net::LDAP::Mock->new('ldap2.example.com'); my $ldap3 = Test::Net::LDAP::Mock->new('ldap3.example.com'); my $ldap4 = Test::Net::LDAP::Mock->new('ldap1.example.com', port => 3389); is($ldap1->mock_data, $ldap2->mock_data); is($ldap1->mock_data, $ldap3->mock_data); isnt($ldap1->mock_data, $ldap4->mock_data); }; do { Test::Net::LDAP::Mock->mock_target('ldap.example.com', port => 389); is_deeply(Test::Net::LDAP::Mock->mock_target(), ['ldap.example.com', {port => 389}]); my $ldap1 = Test::Net::LDAP::Mock->new('ldap1.example.com'); my $ldap2 = Test::Net::LDAP::Mock->new('ldap2.example.com'); my $ldap3 = Test::Net::LDAP::Mock->new('ldap3.example.com', port => 3389); my $ldap4 = Test::Net::LDAP::Mock->new('ldap1.example.com', port => 3389, scheme => 'ldaps'); is($ldap1->mock_data, $ldap2->mock_data); is($ldap1->mock_data, $ldap3->mock_data); isnt($ldap1->mock_data, $ldap4->mock_data); }; do { Test::Net::LDAP::Mock->mock_target(sub { my ($host, $arg) = @_; $host = 'ldap.example.com' if $host =~ /^ldap\d+\.example\.com$/; $arg->{port} = 389; return ($host, $arg); }); is(ref(Test::Net::LDAP::Mock->mock_target()), 'CODE'); my $ldap1 = Test::Net::LDAP::Mock->new('ldap1.example.com'); my $ldap2 = Test::Net::LDAP::Mock->new('ldap2.example.com'); my $ldap3 = Test::Net::LDAP::Mock->new('ldap3.example.com'); my $ldap4 = Test::Net::LDAP::Mock->new('other.example.com'); is($ldap1->mock_data, $ldap2->mock_data); is($ldap1->mock_data, $ldap3->mock_data); isnt($ldap1->mock_data, $ldap4->mock_data); }; Test-Net-LDAP-0.07/t/30-mock-other.t000644 000765 000024 00000002432 12502003676 017165 0ustar00mahirostaff000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 19; use Test::Net::LDAP::Mock::Data; my $data = Test::Net::LDAP::Mock::Data->new; # Basic $data->bind_ok(); $data->unbind_ok(); $data->abandon_ok(); # Root DSE $data->mock_root_dse( namingContexts => 'dc=example,dc=com', supportedLDAPVersion => 3, subschemaSubentry => 'cn=Subscheme', ); ok my $root_dse = $data->root_dse; is($root_dse->get_value('namingContexts'), 'dc=example,dc=com'); is($root_dse->get_value('supportedLDAPVersion'), 3); is($root_dse->get_value('subschemaSubentry'), 'cn=Subscheme'); # Callback - bind my @callback_args; my $mesg; @callback_args = (); $mesg = $data->bind_ok(callback => sub { push @callback_args, \@_; }); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Callback - unbind @callback_args = (); $mesg = $data->unbind_ok(callback => sub { push @callback_args, \@_; }); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); # Callback - abandon @callback_args = (); $mesg = $data->abandon_ok(callback => sub { push @callback_args, \@_; }); is(scalar(@callback_args), 1); is(scalar(@{$callback_args[0]}), 1); cmp_ok($callback_args[0][0], '==', $mesg); Test-Net-LDAP-0.07/lib/Test/000755 000765 000024 00000000000 12504313664 015734 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/lib/Test/Net/000755 000765 000024 00000000000 12504313664 016462 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/lib/Test/Net/LDAP/000755 000765 000024 00000000000 12504313664 017202 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/lib/Test/Net/LDAP.pm000644 000765 000024 00000013272 12504313632 017540 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP; use base qw(Net::LDAP Test::Net::LDAP::Mixin); =head1 NAME Test::Net::LDAP - A Net::LDAP subclass for testing =head1 VERSION Version 0.07 =cut our $VERSION = '0.07'; =head1 SYNOPSIS Basic testing utility use Test::More tests => 1; use Test::Net::LDAP; # Create an object, just like Net::LDAP->new() my $ldap = Test::Net::LDAP->new(...); # Same as $ldap->search(), testing the result to see if it is success my $search = $ldap->search_ok(...search args...); Mocking (See L) use Test::More tests => 1; use Test::Net::LDAP::Util qw(ldap_mockify); ldap_mockify { # Net::LDAP->new() will invoke Test::Net::LDAP::Mock->new() my $ldap = Net::LDAP->new('ldap.example.com'); # Add entries to in-memory data tree $ldap->add('uid=user1, ou=users, dc=example, dc=com'); $ldap->add('uid=user2, ou=users, dc=example, dc=com'); # Test your application ok my_application_routine(); }; =head1 DESCRIPTION This module provides some testing methods for LDAP operations, such as C, C, and C, where each method is suffixed with either C<_ok> or C<_is>. C is a subclass of C, so all the methods defined for C are available in addition to C, C, etc. See L for in-memory testing with fake data, without connecting to the real LDAP servers. See L for some helper subroutines. =head1 METHODS =cut =head2 new Creates a new object. The parameters are the same as C. my $ldap = Test::Net::LDAP->new('ldap.example.com'); =cut =head2 search_ok Available methods: C, C, C, C, C, C, C, C, C Synopsis: $ldap->search_ok(@params); $ldap->search_ok(\@params, $name); Invokes the corresponding method with C<@params> passed as arguments, and tests the result to see if the code is C. Alternatively, C<@params> can be given as an array ref, so that the second argument C<$name> is specified as the test name. C<$name> is an optional test name, and if it is omitted, the test name is automatically configured based on C<$method> and C<@params>. my $search = $ldap->search_ok( base => 'dc=example, dc=com', scope => 'sub', filter => '(cn=*)', ); my $search = $ldap->search_ok( [base => 'dc=example, dc=com', scope => 'sub', filter => '(cn=*)'], 'Testing search (cn=*)' ); =cut =head2 search_is Available methods: C, C, C, C, C, C, C, C, C Synopsis: $ldap->search_is(\@params, $expect, $name); Invokes the corresponding method with C<@params> passed as arguments, and tests the result to see if the code is equal to C<$expect>. C<$expect> can be a result code such as C or an object of C returned by LDAP operations. C<$name> is an optional test name, and if it is omitted, the test name is automatically configured based on C<$method> and C<@params>. use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS); my $mesg = $ldap->add_is( ['uid=duplicate, dc=example, dc=com'], LDAP_ALREADY_EXISTS ); =cut =head2 method_ok $ldap->method_ok($method, @params); $ldap->method_ok($method, \@params, $name); Invokes the method as C<< $ldap->$method(@params) >> and tests the result to see if the code is C. C<$name> is an optional test name, and if it is omitted, the test name is automatically configured based on C<$method> and C<@params>. =cut =head2 method_is $ldap->method_is($method, \@params, $expect, $name); Invokes the method as C<< $ldap->$method(@params) >> and tests the result to see if the code is equal to C<$expect>. C<$expect> can be a result code such as C or an object of C returned by LDAP operations. C<$name> is an optional test name, and if it is omitted, the test name is automatically configured based on C<$method> and C<@params>. =cut =head1 SEE ALSO =over 4 =item * L =item * L =item * L =item * L =back =head1 AUTHOR Mahiro Ando, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Test::Net::LDAP You can also look for information at: =over 4 =item * GitHub repository (report bugs here) L =item * RT: CPAN's request tracker (report bugs here, alternatively) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2013-2015 Mahiro Ando. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut 1; # End of Test::Net::LDAP Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Mixin.pm000644 000765 000024 00000003440 12504277524 020631 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP::Mixin; use Net::LDAP; use Net::LDAP::Constant; use Test::Builder; use Test::Net::LDAP::Util; for my $method (qw(search compare add modify delete moddn bind unbind abandon)) { no strict 'refs'; *{__PACKAGE__.'::'.$method.'_ok'} = sub { my $self = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; return $self->method_ok($method, @_); }; *{__PACKAGE__.'::'.$method.'_is'} = sub { my $self = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; return $self->method_is($method, @_); }; } sub method_ok { my $ldap = shift; my $method = shift; my ($params, $name); if (ref $_[0] eq 'ARRAY') { ($params, $name) = @_; } else { $params = \@_; } my $expected = Net::LDAP::Constant::LDAP_SUCCESS; return $ldap->method_is($method, $params, $expected, $name); } sub method_is { my $ldap = shift; my $method = shift; my ($params, $expected, $name); if (ref $_[0] eq 'ARRAY') { ($params, $expected, $name) = @_; } else { $params = \@_; } my $mesg = $ldap->$method(@$params); unless (defined $name) { my $arg = Net::LDAP::_dn_options(@$params); $name = $method.'('.join(', ', map { my ($param, $value) = ($_, "$arg->{$_}"); $value = substr($value, 0, 32).'...' if length($value) > 32; qq($param => "$value"); } grep { defined $arg->{$_} } qw(base scope filter dn newrdn newsuperior)).')'; } local $Test::Builder::Level = $Test::Builder::Level + 1; Test::Net::LDAP::Util::ldap_result_is($mesg, $expected, $name); return $mesg; } 1; Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Mock/000755 000765 000024 00000000000 12504313664 020073 5ustar00mahirostaff000000 000000 Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Mock.pm000644 000765 000024 00000034567 12504223673 020450 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP::Mock; use base 'Test::Net::LDAP'; use IO::Socket; use Net::LDAP; use Net::LDAP::Constant qw(LDAP_SUCCESS); =head1 NAME Test::Net::LDAP::Mock - A mock LDAP client with simulated search in memory =cut =head1 SYNOPSIS All the LDAP operations are performed in memory, instead of connecting to the real LDAP server. use Test::Net::LDAP::Mock; my $ldap = Test::Net::LDAP::Mock->new(); C is a subclass of L, which is a subclass of L. In the actual test code, L should be used to mock all the C instances in your application code. use Test::More tests => 1; use Test::Net::LDAP::Util qw(ldap_mockify); ldap_mockify { # Anywhere in this block, all the occurrences of Net::LDAP::new are # replaced by Test::Net::LDAP::Mock::new ok my_application_routine(); }; Note: if no LDAP entries have been added to the in-memory directory, the C method will silently succeed with no entries found. Below is an example to set up some fake data for particular test cases. use Test::More tests => 1; use Test::Net::LDAP::Util qw(ldap_mockify); ldap_mockify { my $ldap = Net::LDAP->new('ldap.example.com'); $ldap->add('uid=user1, ou=users, dc=example, dc=com'); $ldap->add('uid=user2, ou=users, dc=example, dc=com'); $ldap->add('cn=group1, ou=groups, dc=example, dc=com', attrs => [ member => [ 'uid=user1, ou=users, dc=example, dc=com', 'uid=user2, ou=users, dc=example, dc=com', ] ]); ok my_application_routine(); }; C maintains a shared LDAP directory tree for the same host/port, while it separates the directory trees for different host/port combinations. Thus, it is important to specify a correct server location consistently. =head1 DESCRIPTION =head2 Overview C provides all the operations of C, while they are performed in memory with fake data that are set up just for testing. It is most useful for developers who write testing for an application that uses LDAP search, while they do not have full control over the organizational LDAP server. In many cases, developers do not have write access to the LDAP data, and the organizational information changes over time, which makes it difficult to write stable test cases with LDAP. C helps developers set up any fake LDAP directory tree in memory, so that they can test sufficient varieties of senarios for the application. Without this module, an alternative way to test an application using LDAP is to run a real server locally during testing. (See how C is tested with a local OpenLDAP server.) However, it may not be always trivial to set up such a server with correct configurations and schemas, where this module makes testing easier. =head2 LDAP Schema In the current version, the LDAP schema is ignored when entries are added or modified, although a schema can optionally be specified only for the search filter matching (based on L). An advantage is that it is much easier to set up fake data with any arbitrary LDAP attributes than to care about all the restrictions with the schema. A disadvantage is that it cannot test schema-sensitive cases. =head2 Controls LDAPv3 controls are not supported (yet). The C parameter given as an argument of a method will be ignored. =head1 METHODS =head2 new Creates a new object. It does not connect to the real LDAP server. Each object is associated with a shared LDAP data tree in memory, depending on the target (host/port/path) and scheme (ldap/ldaps/ldapi). Test::Net::LDAP::Mock->new(); Test::Net::LDAP::Mock->new('ldap.example.com', port => 3389); =cut my $mock_map = {}; my $mock_target; my $mockified = 0; my @mockified_subclasses; sub new { my $class = shift; $class = ref $class || $class; if ($mockified) { if ($class eq 'Net::LDAP') { # Net::LDAP $class = __PACKAGE__; } elsif (!$class->isa(__PACKAGE__)) { # Subclass of Net::LDAP (but not yet of Test::Net::LDAP::Mock) _mockify_subclass($class); } } my $target = &_mock_target; my $self = bless { mock_data => undef, net_ldap_socket => IO::Socket->new(), }, $class; $self->{mock_data} = ($mock_map->{$target} ||= do { require Test::Net::LDAP::Mock::Data; Test::Net::LDAP::Mock::Data->new($self); }); return $self; } sub _mockify_subclass { my ($class) = @_; no strict 'refs'; { unshift @{$class.'::ISA'}, __PACKAGE__; } use strict 'refs'; push @mockified_subclasses, $class; } sub _unmockify_subclasses { no strict 'refs'; { for my $class (@mockified_subclasses) { @{$class.'::ISA'} = grep {$_ ne __PACKAGE__} @{$class.'::ISA'}; } } use strict 'refs'; @mockified_subclasses = (); } sub _mock_target { my $host = shift if @_ % 2; my $arg = &Net::LDAP::_options; if ($mock_target) { my ($new_host, $new_arg); if (ref $mock_target eq 'CODE') { ($new_host, $new_arg) = $mock_target->($host, $arg); } elsif (ref $mock_target eq 'ARRAY') { ($new_host, $new_arg) = @$mock_target; } elsif (ref $mock_target eq 'HASH') { $new_arg = $mock_target; } else { $new_host = $mock_target; } $host = $new_host if defined $new_host; $arg = {%$arg, %$new_arg} if defined $new_arg; } my $scheme = $arg->{scheme} || 'ldap'; # Net::LDAP->new() can take an array ref as hostnames, where # the first host that we can connect to will be used. # For the mock object, let's just pick the first one. if (ref $host) { $host = $host->[0] || ''; } if (length $host) { if ($scheme ne 'ldapi') { if ($arg->{port}) { $host =~ s/:\d+$//; $host .= ":$arg->{port}"; } elsif ($host !~ /:\d+$/) { $host .= ":389"; } } } else { $host = ''; } return "$scheme://$host"; } sub _mock_message { my $self = shift; my $mesg = $self->message(@_); $mesg->{resultCode} = LDAP_SUCCESS; $mesg->{errorMessage} = ''; $mesg->{matchedDN} = ''; $mesg->{raw} = undef; $mesg->{controls} = undef; $mesg->{ctrl_hash} = undef; return $mesg; } #override sub _send_mesg { my $ldap = shift; my $mesg = shift; return $mesg; } =head2 mockify Test::Net::LDAP::Mock->mockify(sub { # CODE }); Inside the code block (recursively), all the occurrences of C are replaced by C. Subclasses of C are also mockified. C is inserted into C<@ISA> of each subclass, only within the context of C. See also: L. =cut sub mockify { my ($class, $callback) = @_; if ($mockified) { $callback->(); } else { $mockified = 1; local *Net::LDAP::new = *Test::Net::LDAP::Mock::new; eval {$callback->()}; my $error = $@; _unmockify_subclasses(); $mockified = 0; die $error if $error; } } =head2 mock_data Retrieves the currently associated data tree (for the internal purpose only). =cut sub mock_data { return shift->{mock_data}; } =head2 mock_schema Gets or sets the LDAP schema (L object) for the currently associated data tree. In this version, the schema is used only for the search filter matching (based on L internally). It has no effect for any modification operations such as C, C, and C. =cut sub mock_schema { my $self = shift; $self->mock_data->schema(@_); } =head2 mock_root_dse Gets or sets the root DSE (L) for the currently associated data tree. This should be set up as part of the test fixture before any successive call to the C method, since L will cache the returned object. $ldap->mock_root_dse( namingContexts => 'dc=example,dc=com' ); Note: the namingContexts value has no effect on the restriction with the topmost DN. In other words, even if namingContexts is set to 'dc=example,dc=com', the C method still allows you to add an entry to 'dc=somewhere-else'. =cut sub mock_root_dse { my $self = shift; $self->mock_data->mock_root_dse(@_); } =head2 mock_bind Gets or sets a LDAP result code (and optionally a message) that will be used as a message returned by a later C call. use Net::LDAP::Constant qw(LDAP_INVALID_CREDENTIALS); $ldap->mock_bind(LDAP_INVALID_CREDENTIALS); $ldap->mock_bind(LDAP_INVALID_CREDENTIALS, 'Login failed'); # ... my $mesg = $ldap->bind(...); $mesg->code && die $mesg->error; #=> die('Login failed') In the list context, it returns an array of the code and message. In the scalar context, it returns the code only. Alternatively, this method can take a callback subroutine: $ldap->mock_bind(sub { my $arg = shift; # Validate $arg->{dn} and $arg->{password}, etc. if (...invalid credentials...) { return LDAP_INVALID_CREDENTIALS; } }); The callback can return a single value as the LDAP result code or an array in the form C<($code, $message)>. If the callback returns nothing (or C), it is regarded as C. =cut sub mock_bind { my $self = shift; $self->mock_data->mock_bind(@_); } =head2 mock_password Gets or sets the password for the simple password authentication with C. $ldap->mock_password('uid=test, dc=example, dc=com' => 'test_password'); # Caution: Passwords should usually *not* be hard-coded like this. Consider to load # passwords from a config file, etc. The passwords are stored with the entry node in the data tree. Once this method is used, the C call will check the credentials whenever the C parameter is passed. Anonymous binding and all the other authentication methods are not affected. =cut sub mock_password { my $self = shift; $self->mock_data->mock_password(@_); } =head2 mock_target Gets or sets the target scheme://host:port to normalize the way for successive C objects to resolve the associated data tree. It is useful when normalizing the target scheme://host:port for different combinations. For example, if there are sub-domains (such as ldap1.example.com and ldap2.example.com) that share the same data tree, the target host should be normalized to be the single master server (such as ldap.example.com). Test::Net::LDAP::Mock->mock_target('ldap.example.com'); Test::Net::LDAP::Mock->mock_target('ldap.example.com', port => 3389); Test::Net::LDAP::Mock->mock_target(['ldap.example.com', {port => 3389}]); Test::Net::LDAP::Mock->mock_target({scheme => 'ldaps', port => 3389}); Since this will affect all the successive calls to instantiate C, it may not be ideal when your application uses connections to multiple LDAP servers. In that case, you can specify a callback that will be invoked each time a C object is instantiated. Test::Net::LDAP::Mock->mock_target(sub { my ($host, $arg) = @_; # Normalize $host, $arg->{port}, and $arg->{scheme} $host = 'ldap.example1.com' if $host =~ /\.example1\.com$/; $host = 'ldap.example2.com' if $host =~ /\.example2\.com$/; return ($host, $arg); }); =cut sub mock_target { my $class = shift; if (@_) { my $old = $mock_target; my $host = shift; if (@_ >= 2) { $mock_target = [$host, {@_}]; } elsif (@_ == 1) { my $arg = shift; $mock_target = [$host, $arg]; } else { $mock_target = $host; } return $old; } else { return $mock_target; } } =head2 search Searches for entries in the currently associated data tree. $ldap->search( base => 'dc=example, dc=com', scope => 'sub', filter => '(cn=*)', attrs => ['uid', 'cn'] ); See L for more parameter usage. =cut sub search { my $ldap = shift; return $ldap->mock_data->search(@_); } =head2 compare Compares an attribute/value pair with an entry in the currently associated data tree. $ldap->compare('uid=test, dc=example, dc=com', attr => 'cn', value => 'Test' ); See L for more parameter usage. =cut sub compare { my $ldap = shift; return $ldap->mock_data->compare(@_); } =head2 add Adds an entry to the currently associated data tree. $ldap->add('uid=test, dc=example, dc=com', attrs => [ cn => 'Test' ]); See L for more parameter usage. =cut sub add { my $ldap = shift; return $ldap->mock_data->add(@_); } =head2 modify Modifies an entry in the currently associated data tree. $ldap->modify('uid=test, dc=example, dc=com', add => [ cn => 'Test2' ]); See L for more parameter usage. =cut sub modify { my $ldap = shift; return $ldap->mock_data->modify(@_); } =head2 delete Deletes an entry from the currently associated data tree. $ldap->delete('uid=test, dc=example, dc=com'); See L for more parameter usage. =cut sub delete { my $ldap = shift; return $ldap->mock_data->delete(@_); } =head2 moddn Modifies DN of an entry in the currently associated data tree. $ldap->moddn('uid=test, dc=example, dc=com', newrdn => 'uid=test2' ); See L for more parameter usage. =cut sub moddn { my $ldap = shift; return $ldap->mock_data->moddn(@_); } =head2 bind Returns an expected result message if the bind result has previously been setup by the C method. Otherwise, a success message is returned. =cut sub bind { my $ldap = shift; return $ldap->mock_data->bind(@_); } =head2 unbind Returns a success message. =cut sub unbind { my $ldap = shift; return $ldap->mock_data->unbind(@_); } =head2 abandon Returns a success message. =cut sub abandon { my $ldap = shift; return $ldap->mock_data->abandon(@_); } 1; Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Util.pm000644 000765 000024 00000010505 12504223750 020452 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP::Util; use base 'Exporter'; use Net::LDAP; use Net::LDAP::Constant qw(LDAP_SUCCESS); use Net::LDAP::Util qw(ldap_error_name ldap_error_text canonical_dn); use Test::Builder; our @EXPORT_OK = qw( ldap_result_ok ldap_result_is ldap_mockify ldap_dn_is ); our %EXPORT_TAGS = (all => \@EXPORT_OK); =head1 NAME Test::Net::LDAP::Util - Testing utilities for Test::Net::LDAP =cut =head1 EXPORT The following subroutines are exported on demand. use Test::Net::LDAP::Util qw( ldap_result_ok ldap_result_is ldap_mockify ldap_dn_is ); All the subroutines are exported if C<:all> is specified. use Test::Net::LDAP::Util ':all'; =cut =head1 SUBROUTINES =cut sub _format_diag { my ($actual_text, $expected_text) = @_; # Indent spaces are based on Test::Builder::_is_diag implementation # ($Test::Builder::VERSION == 0.98) return sprintf("%12s: %s\n", 'got', $actual_text). sprintf("%12s: %s\n", 'expected', $expected_text); } =head2 ldap_result_ok ldap_result_ok($mesg, $name); Tests the result of an LDAP operation to see if the code is C. C<$mesg> is either a Net::LDAP::Message object returned by LDAP operation methods or a result code. C<$name> is the optional test name. =cut sub ldap_result_ok { my ($mesg, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; return ldap_result_is($mesg, LDAP_SUCCESS, $name); } =head2 ldap_result_is ldap_result_is($mesg, $expect, $name); Tests the result of an LDAP operation to see if the code is equal to C<$expect>. The values of C<$mesg> and C<$expect> are either a Net::LDAP::Message object returned by LDAP operation methods or a result code. C<$name> is the optional test name. =cut my $test_builder; sub ldap_result_is { my ($actual, $expected, $name) = @_; $expected = LDAP_SUCCESS unless defined $expected; $test_builder ||= Test::Builder->new; my $actual_code = ref $actual ? $actual->code : $actual; my $expected_code = ref $expected ? $expected->code : $expected; my $success = ($actual_code == $expected_code); local $Test::Builder::Level = $Test::Builder::Level + 1; $test_builder->ok($success, $name); unless ($success) { my $actual_text = ldap_error_name($actual).' ('.$actual_code.'): '. ((ref $actual && $actual->error) || ldap_error_text($actual)); my $expected_text = ldap_error_name($expected).' ('.$expected_code.')'; $test_builder->diag(_format_diag($actual_text, $expected_text)); } return $actual; } =head2 ldap_mockify ldap_mockify { # CODE }; Inside the code block (recursively), all the occurrences of C are replaced by C. Subclasses of C are also mockified. C is inserted into C<@ISA> of each subclass, only within the context of C. See L for more details. =cut sub ldap_mockify(&) { my ($callback) = @_; require Test::Net::LDAP::Mock; Test::Net::LDAP::Mock->mockify($callback); } =head2 ldap_dn_is ldap_dn_is($actual_dn, $expect_dn, $name); Tests equality of two DNs that are not necessarily canonicalized. The comparison is case-insensitive. =cut sub ldap_dn_is { my ($actual_dn, $expected_dn, $name) = @_; my ($actual_canonical_dn, $expected_canonical_dn) = ($actual_dn, $expected_dn); for my $dn ($actual_canonical_dn, $expected_canonical_dn) { $dn = lc canonical_dn($dn, casefold => 'none') if defined $dn; } my $success; if (defined $actual_dn) { if (defined $expected_dn) { $success = $actual_canonical_dn eq $expected_canonical_dn; } else { $success = 0; } } else { $success = !defined $expected_dn; } local $Test::Builder::Level = $Test::Builder::Level + 1; $test_builder ||= Test::Builder->new; $test_builder->ok($success, $name); unless ($success) { my ($actual_text, $expected_text) = ($actual_dn, $expected_dn); for my $text ($actual_text, $expected_text) { $text = defined $text ? "'$text'" : 'undef'; } $test_builder->diag(_format_diag($actual_text, $expected_text)); } } 1; Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Mock/Data.pm000644 000765 000024 00000040047 12504277577 021323 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP::Mock::Data; use base qw(Test::Net::LDAP::Mixin); use Net::LDAP; use Net::LDAP::Constant qw( LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE LDAP_NO_SUCH_OBJECT LDAP_ALREADY_EXISTS LDAP_INVALID_DN_SYNTAX LDAP_PARAM_ERROR LDAP_INVALID_CREDENTIALS LDAP_INAPPROPRIATE_AUTH ); use Net::LDAP::Entry; use Net::LDAP::Filter; use Net::LDAP::FilterMatch; use Net::LDAP::Util qw( canonical_dn escape_dn_value ldap_explode_dn ); use Scalar::Util qw(blessed); use Test::Net::LDAP::Util; my %scope = qw(base 0 one 1 single 1 sub 2 subtree 2); my %deref = qw(never 0 search 1 find 2 always 3); %scope = (%scope, map {$_ => $_} values %scope); %deref = (%deref, map {$_ => $_} values %deref); sub new { my ($class, $ldap) = @_; require Test::Net::LDAP::Mock::Node; my $self = bless { root => Test::Net::LDAP::Mock::Node->new, ldap => $ldap, schema => undef, bind_success => 0, password_mocked => 0, mock_bind_code => LDAP_SUCCESS, mock_bind_message => '', }, $class; $self->{ldap} ||= do { require Test::Net::LDAP::Mock; my $ldap = Test::Net::LDAP::Mock->new; $ldap->{mock_data} = $self; $ldap; }; return $self; } sub root { shift->{root}; } sub schema { my $self = shift; if (@_) { my $schema = $self->{schema}; $self->{schema} = $_[0]; return $schema; } else { return $self->{schema}; } } sub ldap { my $self = shift; if (@_) { my $ldap = $self->{ldap}; $self->{ldap} = $_[0]; return $ldap; } else { return $self->{ldap}; } } sub root_dse { my $self = shift; $self->ldap->root_dse(@_); } sub mock_root_dse { my $self = shift; my $root_node = $self->root; if (@_) { require Net::LDAP::RootDSE; my $old_entry = $root_node->entry; my $new_entry; if ($_[0] && blessed($_[0]) && $_[0]->isa('Net::LDAP::Entry')) { $new_entry = $_[0]->clone; $new_entry->dn(''); unless ($new_entry->isa('Net::LDAP::RootDSE')) { bless $new_entry, 'Net::LDAP::RootDSE'; } } else { $new_entry = Net::LDAP::RootDSE->new('', @_); } unless ($new_entry->get_value('objectClass')) { $new_entry->add(objectClass => 'top'); # Net::LDAP::root_dse uses the filter '(objectclass=*)' to search # for the root DSE. } $root_node->entry($new_entry); return $old_entry; } else { return $root_node->entry; } } sub mock_bind { my $self = shift; my @values = ($self->{mock_bind_code}, $self->{mock_bind_message}); if (@_) { $self->{mock_bind_code} = shift; $self->{mock_bind_message} = shift; } return wantarray ? @values : $values[0]; } sub mock_password { my $self = shift; my $dn = shift or return; if (@_) { my $password = shift; $self->{password_mocked} = 1; my $node = $self->root->make_node($dn); return $node->password($password); } else { my $node = $self->root->get_node($dn) or return; return $node->password(); } } sub _result_entry { my ($self, $input_entry, $arg) = @_; my $attrs = $arg->{attrs} || []; $attrs = [] if grep {$_ eq '*'} @$attrs; my $output_entry; if (@$attrs) { $output_entry = Net::LDAP::Entry->new; $output_entry->dn($input_entry->dn); $output_entry->add( map {$_ => [$input_entry->get_value($_)]} @$attrs ); } else { $output_entry = $input_entry->clone; } $output_entry->changetype('modify'); return $output_entry; } sub _error { my $self = shift; $self->ldap->_error(@_); } sub _mock_message { my $self = shift; $self->ldap->_mock_message(@_); } sub bind { my $self = shift; my $arg = &Net::LDAP::_dn_options; require Net::LDAP::Bind; my $mesg = $self->_mock_message('Net::LDAP::Bind' => $arg); if ($self->{password_mocked} && exists $arg->{password}) { my $dn = $arg->{dn}; if (!defined $dn) { return $self->_error($mesg, LDAP_INAPPROPRIATE_AUTH, 'No password, did you mean noauth or anonymous ?'); } $dn = ldap_explode_dn($dn, casefold => 'lower') or return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); my $node = $self->root->get_node($dn) or return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); unless (defined $node->password && defined $arg->{password} && $node->password eq $arg->{password}) { return $self->_error($mesg, LDAP_INVALID_CREDENTIALS, ''); } } if (my $code = $self->{mock_bind_code}) { my $message = $self->{mock_bind_message} || ''; if (ref $code eq 'CODE') { # Callback my @result = $code->($arg); ($code, $message) = ($result[0] || LDAP_SUCCESS, $result[1] || $message); } if (blessed $code) { # Assume $code is a LDAP::Message ($code, $message) = ($code->code, $message || $code->error); } if ($code != LDAP_SUCCESS) { return $self->_error($mesg, $code, $message); } } if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub unbind { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Unbind' => $arg); if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub abandon { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Abandon' => $arg); if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub search { my $self = shift; my $arg = &Net::LDAP::_dn_options; require Net::LDAP::Search; my $mesg = $self->_mock_message('Net::LDAP::Search' => $arg); # Configure params my $base = $arg->{base} || ''; $base = ldap_explode_dn($base, casefold => 'lower'); unless ($base) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $filter = $arg->{filter}; if (defined $filter && !ref($filter) && $filter ne '') { my $f = Net::LDAP::Filter->new; unless ($f->parse($filter)) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'Bad filter'); } $filter = $f; } else { $filter = undef; } my $scope = defined $arg->{scope} ? $arg->{scope} : 'sub'; $scope = $scope{$scope}; unless (defined $scope) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'invalid scope'); } my $callback = $arg->{callback}; # Traverse tree $mesg->{entries} = []; my $base_node = $base ? $self->root->get_node($base) : $self->root; unless ($base_node) { return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); } $callback->($mesg) if $callback; $base_node->traverse(sub { my ($node) = @_; my $entry = $node->entry; my $schema = $self->schema; if ($entry && (!$filter || $filter->match($entry, $schema))) { my $result_entry = $self->_result_entry($entry, $arg); push @{$mesg->{entries}}, $result_entry; $callback->($mesg, $result_entry) if $callback; } }, $scope); return $mesg; } sub compare { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Compare' => $arg); my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn}); unless ($dn) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified'); } my $dn_list = ldap_explode_dn($dn, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $attr = exists $arg->{attr} ? $arg->{attr} : exists $arg->{attrs} #compat ? $arg->{attrs}[0] : ""; my $value = exists $arg->{value} ? $arg->{value} : exists $arg->{attrs} #compat ? $arg->{attrs}[1] : ""; my $node = $self->root->get_node($dn_list); unless ($node && $node->entry) { return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); } my $entry = $node->entry; my $filter = bless { equalityMatch => { attributeDesc => $attr, assertionValue => $value, } }, 'Net::LDAP::Filter'; $mesg->{resultCode} = $filter->match($entry, $self->schema) ? LDAP_COMPARE_TRUE : LDAP_COMPARE_FALSE; if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub add { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Add' => $arg); my $dn = ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn}; unless ($dn) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified'); } my $dn_list = ldap_explode_dn($dn, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $node = $self->root->make_node($dn); if ($node->entry) { return $self->_error($mesg, LDAP_ALREADY_EXISTS, ''); } my $entry; if (ref $arg->{dn}) { $entry = $arg->{dn}->clone; } else { $entry = Net::LDAP::Entry->new( $arg->{dn}, @{$arg->{attrs} || $arg->{attr} || []} ); } if (my $rdn = $dn_list->[0]) { $entry->delete(%$rdn); $entry->add(%$rdn); } $entry->changetype('add'); $node->entry($entry); if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } my %opcode = (add => 0, delete => 1, replace => 2, increment => 3); sub modify { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Modify' => $arg); my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn}); unless ($dn) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified'); } my $dn_list = ldap_explode_dn($dn, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $node = $self->root->get_node($dn_list); unless ($node && $node->entry) { return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); } my $entry = $node->entry; if (exists $arg->{changes}) { for (my $j = 0; $j < @{$arg->{changes}}; $j += 2) { my $op = $arg->{changes}[$j]; my $chg = $arg->{changes}[$j + 1]; unless (defined $opcode{$op}) { return $self->_error($mesg, LDAP_PARAM_ERROR, "Bad change type '$op'"); } $entry->$op(@$chg); } } else { for my $op (keys %opcode) { my $chg = $arg->{$op} or next; my $opcode = $opcode{$op}; my $ref_chg = ref $chg; if ($opcode == 3) { # $op eq 'increment' if ($ref_chg eq 'HASH') { for my $attr (keys %$chg) { my $incr = $chg->{$attr}; $entry->replace( $attr => [map {$_ + $incr} $entry->get_value($attr)] ); } } elsif ($ref_chg eq 'ARRAY') { for (my $i = 0; $i < @$chg; $i += 2) { my ($attr, $incr) = ($chg->[$i], $chg->[$i + 1]); next unless defined $incr; $entry->replace( $attr => [map {$_ + $incr} $entry->get_value($attr)] ); } } elsif (!$ref_chg) { $entry->replace( $chg => [map {$_ + 1} $entry->get_value($chg)] ); } } elsif ($ref_chg eq 'HASH') { $entry->$op(%$chg); } elsif ($ref_chg eq 'ARRAY') { if ($opcode == 1) { # $op eq 'delete' $entry->$op(map {$_ => []} @$chg); } else { $entry->$op(@$chg); } } elsif (!$ref_chg) { $entry->$op($chg => []); } } } if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub delete { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::Delete' => $arg); my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn}); unless ($dn) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified'); } my $dn_list = ldap_explode_dn($dn, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $node = $self->root->get_node($dn_list); unless ($node && $node->entry) { return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); } $node->entry(undef); if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } sub moddn { my $self = shift; my $arg = &Net::LDAP::_dn_options; my $mesg = $self->_mock_message('Net::LDAP::ModDN' => $arg); my $dn = (ref $arg->{dn} ? $arg->{dn}->dn : $arg->{dn}); unless ($dn) { return $self->_error($mesg, LDAP_PARAM_ERROR, 'No DN specified'); } my $dn_list = ldap_explode_dn($dn, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid DN'); } my $old_rdn = $dn_list->[0]; my $old_node = $self->root->get_node($dn_list); unless ($old_node && $old_node->entry) { return $self->_error($mesg, LDAP_NO_SUCH_OBJECT, ''); } # Configure new RDN my $new_rdn; my $rdn_changed = 0; if (defined(my $new_rdn_value = $arg->{newrdn})) { my $new_rdn_list = ldap_explode_dn($new_rdn_value, casefold => 'lower'); unless ($new_rdn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid new RDN'); } $new_rdn = $new_rdn_list->[0]; $rdn_changed = 1; } else { $new_rdn = $dn_list->[0]; } # Configure new DN if (defined(my $new_superior = $arg->{newsuperior})) { $dn_list = ldap_explode_dn($new_superior, casefold => 'lower'); unless ($dn_list) { return $self->_error($mesg, LDAP_INVALID_DN_SYNTAX, 'invalid newSuperior'); } unshift @$dn_list, $new_rdn; } else { $dn_list->[0] = $new_rdn; } my $new_dn = canonical_dn($dn_list, casefold => 'lower'); # Create new node my $new_node = $self->root->make_node($dn_list); if ($new_node->entry) { return $self->_error($mesg, LDAP_ALREADY_EXISTS, ''); } # Set up new entry my $new_entry = $old_node->entry; $old_node->entry(undef); $new_entry->dn($new_dn); if ($rdn_changed) { if ($arg->{deleteoldrdn}) { $new_entry->delete(%$old_rdn); } $new_entry->delete(%$new_rdn); $new_entry->add(%$new_rdn); } $new_node->entry($new_entry); if (my $callback = $arg->{callback}) { $callback->($mesg); } return $mesg; } 1; Test-Net-LDAP-0.07/lib/Test/Net/LDAP/Mock/Node.pm000644 000765 000024 00000005200 12502004031 021272 0ustar00mahirostaff000000 000000 use 5.006; use strict; use warnings; package Test::Net::LDAP::Mock::Node; use Net::LDAP::Util qw(canonical_dn ldap_explode_dn); use Scalar::Util qw(blessed); sub new { my ($class) = @_; return bless { entry => undef, submap => {}, password => undef, }, $class; } sub entry { my $self = shift; if (@_) { my $old = $self->{entry}; $self->{entry} = shift; return $old; } else { return $self->{entry}; } } sub make_node { my ($self, $spec) = @_; return $self->_descend_path($spec, sub { my ($node, $rdn) = @_; return $node->_make_subnode($rdn); }); } sub get_node { my ($self, $spec) = @_; return $self->_descend_path($spec, sub { my ($node, $rdn) = @_; return $node->_get_subnode($rdn); }); } sub traverse { my ($self, $callback, $scope) = @_; $scope ||= 0; # 0: base, 1: one, 2: sub my $visit; $visit = sub { my ($node, $deep) = @_; $callback->($node); # $deep == 0 or 1 if ($scope > $deep) { $node->_each_subnode(sub { my ($subnode) = @_; $visit->($subnode, 1); }); } }; $visit->($self, 0); } sub password { my $self = shift; my $password = $self->{password}; $self->{password} = shift if @_; return $password; } sub _descend_path { my ($self, $spec, $callback) = @_; if (ref $spec eq 'HASH') { my $node = $callback->($self, $spec); return $node; } else { my $dn_list; if (ref $spec eq 'ARRAY') { $dn_list = $spec; } else { my $dn = blessed($spec) ? $spec->dn : $spec; $dn_list = ldap_explode_dn($dn, casefold => 'lower'); } my $node = $self; my $parent; for my $rdn (reverse @$dn_list) { $parent = $node; $node = $callback->($node, $rdn) or last; } return $node; } } sub _make_subnode { my ($self, $rdn) = @_; # E.g. $rdn == {ou => 'Sales'} my $canonical = lc canonical_dn([$rdn], casefold => 'none'); return $self->{submap}{$canonical} ||= ref($self)->new; } sub _get_subnode { my ($self, $rdn) = @_; # E.g. $rdn == {ou => 'Sales'} my $canonical = lc canonical_dn([$rdn], casefold => 'none'); return $self->{submap}{$canonical}; } sub _each_subnode { my ($self, $callback) = @_; my $submap = $self->{submap}; for my $canonical (keys %$submap) { $callback->($submap->{$canonical}); } } 1;