This file is indexed.

/usr/share/perl5/Net/LDAP/Server.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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
# ===========================================================================
# Net::LDAP::Server
# 
# LDAP server side protocol handling
# 
# Alessandro Ranellucci <aar@cpan.org>
# Hans Klunder <hans.klunder@bigfoot.com>
# Copyright (c) 2005-2007.
# 
# See below for documentation.
# 
package Net::LDAP::Server;
use strict;
use warnings;

use Convert::ASN1 qw(asn_read);
use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
use Net::LDAP::Constant qw(LDAP_OPERATIONS_ERROR LDAP_UNWILLING_TO_PERFORM);
use Net::LDAP::Entry;

our $VERSION = '0.4';
use fields qw(socket);

our %respTypes=(
	'bindRequest' => 'bindResponse', 
	'unbindRequest' => '',
	'searchRequest' => 'searchResDone',
	'modifyRequest' => 'modifyResponse', 
	'addRequest'  => 'addResponse', 
	'delRequest' => 'delResponse',
	'modDNRequest' => 'modDNResponse',
	'compareRequest' => 'compareResponse',
	'extendedReq' => 'extendedResp',
	'abandonRequest' => ''
);
our %functions=(
	'bindRequest' => 'bind', 
	'unbindRequest' => 'unbind',
	'searchRequest' => 'search',
	'modifyRequest' => 'modify', 
	'addRequest'  => 'add', 
	'delRequest' => 'delete',
	'modDNRequest' => 'modifyDN',
	'compareRequest' => 'compare',
	'extendedReq' => 'extended',
	'abandonRequest' => 'abandon'
);
our @reqTypes = keys %respTypes;

sub new {
    my ($proto, $sock) = @_;
	my $class = ref($proto) || $proto;
	my $self = fields::new($class);
	$self->{socket} = $sock;
	return $self;
}

sub handle {
	my Net::LDAP::Server $self = shift;
	my $socket = $self->{socket};
	
	asn_read($socket, my $pdu);
	#print '-' x 80,"\n";
	#print "Received:\n";
	#Convert::ASN1::asn_dump(\*STDOUT,$pdu);
	my $request = $LDAPRequest->decode($pdu);
	my $mid = $request->{'messageID'} 
		or return 1;

	#print "messageID: $mid\n";
	#use Data::Dumper; print Dumper($request);
	
	my $reqType;
	foreach my $type (@reqTypes) {
		if (defined $request->{$type}) {
			$reqType = $type;
			last;
		}
	}
	my $respType = $respTypes{$reqType}
		or return 1;  # if no response type is present hangup the connection

	my $reqData = $request->{$reqType};
		
	# here we can do something with the request of type $reqType
	my $method = $functions{$reqType};
	my $result;
	if ($self->can($method)){
		if ($method eq 'search') {
			my @entries;
			eval { ($result,@entries) = $self->search($reqData, $request) };
		
			foreach my $entry (@entries) {
				my $data;
				# default is to return a searchResEntry
				my $sResType = 'searchResEntry';
				if (ref $entry eq 'Net::LDAP::Entry') {
					$data = $entry->{'asn'};		
				} elsif (ref $entry eq 'Net::LDAP::Reference') {
					$data = $entry->{'asn'};
					$sResType = 'searchResRef';
				} else{
					$data = $entry;
				}
				
				my $response;			
				#  is the full message specified?	
				if (defined $data->{'protocolOp'}) {
					$response = $data;
					$response->{'messageID'} = $mid;
				} else {
					$response = {
						'messageID' => $mid,
       				   	'protocolOp' => {
	       			   		 $sResType => $data
	       		   		}
	       		   	};		 
				}
				my $pdu = $LDAPResponse->encode($response);
				if ($pdu) {
					print $socket $pdu;
				} else {
					$result = undef;
					last;
				}
			}
		} else {
			eval { $result = $self->$method($reqData, $request) };
		}
		$result = _operations_error() unless $result;
	} else {
		$result = {
			'matchedDN' => '',
			'errorMessage' => sprintf("%s operation is not supported by %s", $method, ref $self),
			'resultCode' => LDAP_UNWILLING_TO_PERFORM     
		};
	}
	
	# and now send the result to the client
	print $socket &_encode_result($mid, $respType, $result);
	
	return 0;
}	

sub _encode_result {
	my ($mid, $respType, $result) = @_;
	
	my $response = {
		'messageID' => $mid,
      	'protocolOp' => {
			$respType => $result
		}
	};
	my $pdu = $LDAPResponse->encode($response);
	
	# if response encoding failed return the error
	if (!$pdu) {
		$response->{'protocolOp'}->{$respType} = _operations_error();
		$pdu = $LDAPResponse->encode($response);
	};
	
	return $pdu;
}

sub _operations_error {
	my $err = $@;
	$err =~ s/ at .+$//;
	return {
		'matchedDN' => '',
		'errorMessage' => $err,
		'resultCode' => LDAP_OPERATIONS_ERROR          
	};
}

1;

__END__

=head1 NAME

Net::LDAP::Server - LDAP server side protocol handling

=head1 SYNOPSIS

  package MyServer;
  use Net::LDAP::Server;
  use Net::LDAP::Constant qw(LDAP_SUCCESS);
  use base 'Net::LDAP::Server';
  sub search {
      my $self = shift;
      my ($reqData, $fullRequest) = @_;
      print "Searching\n";
      ...
      return {
          'matchedDN' => '',
          'errorMessage' => '',
          'resultCode' => LDAP_SUCCESS
      }, @entries;
  }
  
  package main;
  my $handler = MyServer->new($socket);
  $handler->handle;

=head1 ABSTRACT

This class provides the protocol handling for an LDAP server. You can subclass
it and implement the methods you need (see below). Then you just instantiate 
your subclass and call its C<handle> method to establish a connection with the client.

=head1 SUBCLASSING

You can subclass Net::LDAP::Server with the following lines:

  package MyServer;
  use Net::LDAP::Server;
  use base 'Net::LDAP::Server';

Then you can add your custom methods by just implementing a subroutine
named after the name of each method. These are supported methods:

=over 4

=item C<bind>

=item C<unbind>

=item C<search>

=item C<add>

=item C<modify>

=item C<delete>

=item C<modifyDN>

=item C<compare>

=item C<abandon>

=back

For any method that is not supplied, Net::LDAP::Server will return an 
C<LDAP_UNWILLING_TO_PERFORM>.

=head2 new()

You can also subclass the C<new> constructor to do something at connection time:

  sub new {
     my ($class, $sock) = @_;
     my $self = $class->SUPER::new($sock);
     printf "Accepted connection from: %s\n", $sock->peerhost();
     return $self;
  }

Note that $self is constructed using the L<fields> pragma, so if you want to add
data to it you should add a line like this in your subclass:

  use fields qw(myCustomField1 myCustomField2);

=head2 Methods

When a method is invoked it will be obviously passed C<$self> as generated by 
C<new>, and two variables:

=over 4

=item *
the Request datastructure that is specific for this method (e.g. BindRequest);

=item *
the full request message (useful if you want to access I<messageID> or I<controls> parts)

=back

You can look at L<Net::LDAP::ASN> or use L<Data::Dumper> to find out what is 
presented to your method:

  use Data::Dumper;
  sub search {
     print Dumper \@_;
  }

If anything goes wrong in the module you specify (e.g. it died or the result 
is not a correct ldapresult structure) Net::LDAP::Server will return an 
C<LDAP_OPERATIONS_ERROR> where the errorMessage will specify what went 
wrong. 

All methods should return a LDAPresult hashref, for example:

  return({
      'matchedDN' => '',
      'errorMessage' => '',
      'resultCode' => LDAP_SUCCESS
  });

C<search> should return a LDAPresult hashref followed by a list of entries 
(if applicable). Entries may be coded either as searchResEntry or 
searchRefEntry structures or as L<Net::LDAP::Entry> or L<Net::LDAP::Reference>
objects.

=head1 CLIENT HANDLING

=head2 handle()

When you get a socket from a client you can instantiate the class and handle 
the request:

  my $handler = MyServer->new($socket);
  $handler->handle;

See examples in I<examples/> directory for sample servers, using L<IO::Select> 
or L<Net::Daemon>.

=head1 DEPENDENCIES

 Net::LDAP::ASN
 Net::LDAP::Constant

=head1 SEE ALSO

=over 4

=item L<Net::LDAP>

=item Examples in I<examples> directory.

=back

=head1 BUGS AND FEEDBACK

There are no known bugs. You are very welcome to write mail to the maintainer 
(aar@cpan.org) with your contributions, comments, suggestions, bug reports 
or complaints.

=head1 COPYRIGHT

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Alessandro Ranellucci E<lt>aar@cpan.orgE<gt>
The original author of a Net::LDAP::Daemon module is 
Hans Klunder E<lt>hans.klunder@bigfoot.comE<gt>

=cut