Skip Menu |
 

This queue is for tickets about the Net-LDAP-Server-Test CPAN distribution.

Report information
The Basics
Id: 80377
Status: resolved
Priority: 0/
Queue: Net-LDAP-Server-Test

People
Owner: karman [...] cpan.org
Requestors: RPORRES [...] cpan.org
rporres [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: (no value)
Fixed in: (no value)



Subject: Net-LDAP-Server-Test returns wrong error codes in some cases
Download (untitled) / with headers
text/plain 1010b
After further inspecting the Net::Server::LDAP::Test code after RT 80360 I've realized that some error codes returned by the server were not correct. - Add a new entry that already exists should return 68 - Delete an entry that doesn't exist should return 32 - Modify an entry that doesn't exist should return 32 - Delete a non-existing attribute in an entry should return 16 - Add an attribute that already exists with the value given should return 20 - ModDN of an entry that doesn't exist should return 32 - ModDN to an entry that already exists should return 68 I'm assuming in every case that auto_schema is set to 1 I attach a patch proposal covering both RT 80360 and this ticket. I also attach a test that expands the one that I provided in RT 80360. ModDN normal case is not working as expected, as for an unknown reason, LDAP message as decoded by Net::LDAP doesn't always containg newSuperior attribute. I've left the code and the test cases as it should work. Best regards, Rafael Porres
Subject: error-codes.t
Download error-codes.t
text/x-perl 2.8k
use strict; use warnings; use Test::More; use Net::LDAP::Server::Test; use Net::LDAP; use Net::LDAP::LDIF; use File::Temp qw(tempfile); # Create ldif my $ldif_entries =<<EOL; dn: app=test app: test objectClass: top objectClass: application dn: msisdn=34610123123,app=test objectClass: msisdn msisdn: 34610123123 dn: msisdn=34699123456,app=test objectClass: msisdn msisdn: 34699123456 EOL my ($fh, $filename) = tempfile(); print $fh $ldif_entries; close $fh; # Create and connect to server ok(my $server = Net::LDAP::Server::Test->new(12389, auto_schema => 1), "test LDAP server spawned"); ok(my $ldap = Net::LDAP->new('localhost', port => 12389), "new LDAP connection" ); # Load ldif my $ldif = Net::LDAP::LDIF->new($filename, 'r', onerror => 'die', lowercase => 1); while (not $ldif->eof) { my $entry = $ldif->read_entry or die "Unable to parse entry"; my $mesg = $ldap->add($entry); $mesg->code and die sprintf "Error adding entry [%s]: [%s]", $entry->dn, $mesg->error; } $ldif->done; # Add an existing entry should return 68 my $mesg = $ldap->add('msisdn=34610123123,app=test', attr => [ objectClass => ['msisdn'], msisdn => 34610123123 ]); is($mesg->code, 68, 'add error'); # Base search ok $mesg = $ldap->search(base => 'msisdn=34610123123,app=test', scope => 'base', filter => 'objectClass=*'); is($mesg->code, 0, 'msisdn found'); # A base search to a non-existing entry should return 32 $mesg = $ldap->search(base => 'msisdn=123456789,app=test', scope => 'base', filter => 'objectClass=*'); is($mesg->code, 32, 'msisdn not found'); is(scalar($mesg->entries), 0, 'number of entries equals zero'); # Modify a non-existing entry should return 32 $mesg = $ldap->modify('msisdn=123456789,app=test', add => { newattr => 'lala' }); is($mesg->code, 32, 'cannot modify a not existing entry'); # Modify ok to an existing entry $mesg = $ldap->modify('msisdn=34610123123,app=test', add => { newattr => 'lala' }); is($mesg->code, 0, 'mod done'); # Modify-add to an existing attribute should return 20 $mesg = $ldap->modify('msisdn=34610123123,app=test', add => { newattr => 'lala' }); is($mesg->code, 20, 'mod fails'); # Modify-delete ok $mesg = $ldap->modify('msisdn=34610123123,app=test', delete => ['newattr']); is($mesg->code, 0, 'mod ok'); # Modify-delete to a non-existing attribute should return 16 $mesg = $ldap->modify('msisdn=34610123123,app=test', delete => ['newattr']); is($mesg->code, 16, 'mod fails'); # Moddn ok $mesg = $ldap->moddn('msisdn=34699123456,app=test', newrdn => 'msisdn=34699000111'); is($mesg->code, 0, 'moddn ok'); # Moddn on a non-existing entry should return 32 $mesg = $ldap->moddn('msisdn=34699123456,app=test', newrdn => 'msisdn=34699000111'); is($mesg->code, 32, 'moddn ok'); # Moddn to an existing dn should return 68 $mesg = $ldap->moddn('msisdn=34699000111,app=test', newrdn => 'msisdn=34610123123', deleteoldrdn => 1); is($mesg->code, 68, 'moddn fails'); done_testing;
Subject: patch_error_codes.txt
--- /var/tmp/Test.pm 2012-10-24 13:18:59.000000000 +0200 +++ Test.pm 2012-10-24 12:05:31.000000000 +0200 @@ -51,9 +51,13 @@ use Carp; use Net::LDAP::Constant qw( LDAP_SUCCESS + LDAP_NO_SUCH_OBJECT LDAP_CONTROL_PAGED LDAP_OPERATIONS_ERROR LDAP_UNWILLING_TO_PERFORM + LDAP_ALREADY_EXISTS + LDAP_TYPE_OR_VALUE_EXISTS + LDAP_NO_SUCH_ATTRIBUTE ); use Net::LDAP::Util qw(ldap_explode_dn); use Net::LDAP::Entry; @@ -72,6 +76,30 @@ 'resultCode' => LDAP_SUCCESS }; + use constant RESULT_NO_SUCH_OBJECT => { + 'matchedDN' => '', + 'errorMessage' => '', + 'resultCode' => LDAP_NO_SUCH_OBJECT, + }; + + use constant RESULT_ALREADY_EXISTS => { + 'matchedDN' => '', + 'errorMessage' => '', + 'resultCode' => LDAP_ALREADY_EXISTS, + }; + + use constant RESULT_TYPE_OR_VALUE_EXISTS => { + 'matchedDN' => '', + 'errorMessage' => '', + 'resultCode' => LDAP_TYPE_OR_VALUE_EXISTS, + }; + + use constant RESULT_NO_SUCH_ATTRIBUTE => { + 'matchedDN' => '', + 'errorMessage' => '', + 'resultCode' => LDAP_NO_SUCH_ATTRIBUTE, + }; + our %Data; # package data lasts as long as $$ does. our $Cookies = 0; our %Searches; @@ -145,6 +173,11 @@ } + # Return LDAP_NO_SUCH_OBJECT if base does not exist + if ( !exists $Data{$base} ) { + return RESULT_NO_SUCH_OBJECT; + } + #warn "stored Data: " . Data::Dump::dump \%Data; #warn "searching for " . Data::Dump::dump \@filters; @@ -391,8 +424,12 @@ #warn 'ADD: ' . Data::Dump::dump \@_; - my $entry = Net::LDAP::Entry->new; my $key = $reqData->{objectName}; + if ( exists $Data{$key} ) { + return RESULT_ALREADY_EXISTS; + } + + my $entry = Net::LDAP::Entry->new; $entry->dn($key); for my $attr ( @{ $reqData->{attributes} } ) { $entry->add( $attr->{type} => \@{ $attr->{vals} } ); @@ -414,7 +451,7 @@ my $key = $reqData->{object}; if ( !exists $Data{$key} ) { - croak "can't modify a non-existent entry: $key"; + return RESULT_NO_SUCH_OBJECT; } my @mods = @{ $reqData->{modification} }; @@ -422,10 +459,24 @@ my $attr = $mod->{modification}->{type}; my $vals = $mod->{modification}->{vals}; my $entry = $Data{$key}; + + my $current_value = $entry->get_value($attr, asref => 1); + if ( $mod->{operation} == 0 ) { + if ( defined $current_value ) { + for my $v ( @$current_value ) { + if ( grep { $_ eq $v } @$vals ) { + return RESULT_TYPE_OR_VALUE_EXISTS; + } + } + } + $entry->add( $attr => $vals ); } elsif ( $mod->{operation} == 1 ) { + if ( ! defined $current_value ) { + return RESULT_NO_SUCH_ATTRIBUTE; + } $entry->delete( $attr => $vals ); } elsif ( $mod->{operation} == 2 ) { @@ -451,7 +502,7 @@ my $key = $reqData; if ( !exists $Data{$key} ) { - croak "can't delete a non-existent entry: $key"; + return RESULT_NO_SUCH_OBJECT; } delete $Data{$key}; @@ -467,7 +518,10 @@ my $oldkey = $reqData->{entry}; my $newkey = join( ',', $reqData->{newrdn}, $reqData->{newSuperior} ); if ( !exists $Data{$oldkey} ) { - croak "can't modifyDN for non-existent entry: $oldkey"; + return RESULT_NO_SUCH_OBJECT; + } + if ( exists $Data{$newkey} ) { + return RESULT_ALREADY_EXISTS; } my $entry = $Data{$oldkey}; my $newentry = $entry->clone;
Download (untitled) / with headers
text/plain 433b
Thanks for the reports and patches. I have applied the patches here: https://github.com/karpet/net-ldap-server-test I have 2 failing tests in t/07-error-codes.t that I am not sure about. I won't release a new version to CPAN till we get some resolution on those, so please confirm if they are legitimate failures or if the tests are faulty. Thanks. PS: forking on github and making pull requests may speed up the patch process.
Download (untitled) / with headers
text/plain 805b
Hi Peter, Thanks for reviewing the code and applying the patch. I've taken a look to the problem of the failing tests. There's a pull request in https://github.com/karpet/net-ldap-server-test/pull/2 which explains the code changes that I've made to solve the issues. Best regards, Rafa El Mié Oct 24 23:03:32 2012, KARMAN escribió: Show quoted text
> Thanks for the reports and patches. > > I have applied the patches here: > https://github.com/karpet/net-ldap-server-test > > I have 2 failing tests in t/07-error-codes.t that I am not sure about. > I won't release a new > version to CPAN till we get some resolution on those, so please > confirm if they are legitimate > failures or if the tests are faulty. > > Thanks. > > PS: forking on github and making pull requests may speed up the patch > process.
patched and released as 0.16.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.