File: MyDemoServer.pm

package info (click to toggle)
libnet-ldap-server-perl 0.43-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 116 kB
  • sloc: perl: 282; makefile: 2
file content (105 lines) | stat: -rw-r--r-- 2,250 bytes parent folder | download | duplicates (2)
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
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 = shift;
	my $self = $class->SUPER::new(@_);
	return $self;
}

# the bind operation
sub bind {
	my $self = shift;
	my $reqData = shift;
	print STDERR Dumper($reqData);
	return RESULT_OK;
}

# the search operation
sub search {
	my $self = shift;
	my $reqData = shift;
	print STDERR "Searching...\n";
	print STDERR 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;