/usr/share/doc/libnet-ldap-server-perl/examples/MyDemoServer.pm is in libnet-ldap-server-perl 0.4-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | package MyDemoServer;
use strict;
use warnings;
use Data::Dumper;
use lib '../lib';
use Net::LDAP::Constant qw(LDAP_SUCCESS);
use Net::LDAP::Server;
use base 'Net::LDAP::Server';
use fields qw();
use constant RESULT_OK => {
'matchedDN' => '',
'errorMessage' => '',
'resultCode' => LDAP_SUCCESS
};
# constructor
sub new {
my ($class, $sock) = @_;
my $self = $class->SUPER::new($sock);
printf "Accepted connection from: %s\n", $sock->peerhost();
return $self;
}
# the bind operation
sub bind {
my $self = shift;
my $reqData = shift;
print Dumper($reqData);
return RESULT_OK;
}
# the search operation
sub search {
my $self = shift;
my $reqData = shift;
print "Searching...\n";
print Dumper($reqData);
my $base = $reqData->{'baseObject'};
# plain die if dn contains 'dying'
die("panic") if $base =~ /dying/;
# return a correct LDAPresult, but an invalid entry
return RESULT_OK, {test => 1} if $base =~ /invalid entry/;
# return an invalid LDAPresult
return {test => 1} if $base =~ /invalid result/;
my @entries;
if ($reqData->{'scope'}) {
# onelevel or subtree
for (my $i=1; $i<11; $i++) {
my $dn = "ou=test $i,$base";
my $entry = Net::LDAP::Entry->new;
$entry->dn($dn);
$entry->add(
dn => $dn,
sn => 'value1',
cn => [qw(value1 value2)]
);
push @entries, $entry;
}
my $entry1 = Net::LDAP::Entry->new;
$entry1->dn("cn=dying entry,$base");
$entry1->add(
cn => 'dying entry',
description => 'This entry will result in a dying error when queried'
);
push @entries, $entry1;
my $entry2 = Net::LDAP::Entry->new;
$entry2->dn("cn=invalid entry,$base");
$entry2->add(
cn => 'invalid entry',
description => 'This entry will result in ASN1 error when queried'
);
push(@entries,$entry2);
my $entry3 = Net::LDAP::Entry->new;
$entry3->dn("cn=invalid result,$base");
$entry3->add(
cn => 'invalid result',
description => 'This entry will result in ASN1 error when queried'
);
push @entries, $entry3;
} else {
# base
my $entry = Net::LDAP::Entry->new;
$entry->dn($base);
$entry->add(
dn => $base,
sn => 'value1',
cn => [qw(value1 value2)]
);
push @entries, $entry;
}
return RESULT_OK, @entries;
}
# the rest of the operations will return an "unwilling to perform"
1;
|