Net-LDAP-Server-0.43/000755 000765 000024 00000000000 11567522742 013722 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/Changelog000644 000765 000024 00000001367 11567522606 015542 0ustar00alstaff000000 000000 version 0.43 (2011/05/26): - added support for Net::Server by allowing the usage of distinct filehandles for input and output (patch by Alexei Znamensky) version 0.42 (2009/10/01): - don't hangup when receiving abandonRequest in order to support clients like Evolution which expect that the socket is still alive after such a request (patch by Bill Lindley) version 0.4 (2007/10/27): - added support for method "abandon" - full request is now passed to methods - compatibility with the changed behaviour of the 'use fields' pragma in Perl 5.9.x (thanks to Peter Karman) version 0.3 (2005/12/22): - added t/02-pod.t and t/03-podcoverage.t - moved pm to lib/ - fixed POD error version 0.2 (2005/11/28): - new Net-LDAP-Server-0.43/examples/000755 000765 000024 00000000000 11567522742 015540 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/lib/000755 000765 000024 00000000000 11567522742 014470 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/Makefile.PL000644 000765 000024 00000001241 11567522235 015667 0ustar00alstaff000000 000000 use ExtUtils::MakeMaker; use 5.006000; WriteMakefile( 'NAME' => 'Net::LDAP::Server', 'ABSTRACT' => 'LDAP server side protocol handling', 'AUTHOR' => 'Alessandro Ranellucci ', 'VERSION_FROM' => 'lib/Net/LDAP/Server.pm', 'PMLIBDIRS' => [ 'lib' ], 'PREREQ_PM' => { Net::LDAP => 0, Convert::ASN1 => 0 }, 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' }, 'DISTNAME' => 'Net-LDAP-Server', 'LICENSE' => 'perl', 'test' => { 'TESTS' => 't/*.t' }, 'META_MERGE' => { resources => { repository => 'git://git@github.com:alexrj/Net-LDAP-Server.git', }, }, ); Net-LDAP-Server-0.43/MANIFEST000644 000765 000024 00000000410 11567522235 015043 0ustar00alstaff000000 000000 Changelog examples/forking-server.pl examples/MyDemoServer.pm examples/simple-server.pl lib/Net/LDAP/Server.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README t/01-use.t t/02-pod.t t/03-podcoverage.t Net-LDAP-Server-0.43/MANIFEST.SKIP000644 000765 000024 00000000764 11567522235 015624 0ustar00alstaff000000 000000 makedocs.pl \.shipit \.brackup$ \.DS_Store$ # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \b_darcs\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b Net-LDAP-Server-0.43/META.yml000644 000765 000024 00000001222 11567522742 015170 0ustar00alstaff000000 000000 --- #YAML:1.0 name: Net-LDAP-Server version: 0.43 abstract: LDAP server side protocol handling author: - Alessandro Ranellucci license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Convert::ASN1: 0 Net::LDAP: 0 resources: repository: git://git@github.com:alexrj/Net-LDAP-Server.git no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-LDAP-Server-0.43/README000644 000765 000024 00000002543 11567522060 014577 0ustar00alstaff000000 000000 -------- Abstract -------- Net::LDAP::Server provides the protocol handling for an LDAP server. You can subclass it and implement the methods you need. Then you just instantiate your subclass and call its C method to establish a connection with the client. ------------ Requirements ------------ Net::LDAP::Server requires Net::LDAP and Convert::ASN1. ------------------ Basic Installation ------------------ Net::LDAP::Server may be installed through the CPAN shell in the usual manner. Typically: $ perl -MCPAN -e 'install Net::LDAP::Server' You can also read this README from the CPAN shell: $ perl -MCPAN -e shell cpan> readme Net::LDAP::Server And you can install the component from the CPAN prompt as well: cpan> install Net::LDAP::Server ------------------- Manual Installation ------------------- This module may also be installed manually. Its distribution is available from the author's CPAN directory, , or a similarly named directory at your favorite CPAN mirror. Downloading and unpacking the distribution are left as exercises for the reader. To build and test it: perl Makefile.PL make test When you're ready to install the component: make install It should now be ready to use. Thanks for reading! -- Alessandro Ranellucci / aar@cpan.org / http://alex.primafila.net Net-LDAP-Server-0.43/t/000755 000765 000024 00000000000 11567522742 014165 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/t/01-use.t000644 000765 000024 00000000250 11567522060 015352 0ustar00alstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test; BEGIN { plan tests => 1 } use ExtUtils::testlib; use Net::LDAP::Server; ok eval "require Net::LDAP::Server"; 1; Net-LDAP-Server-0.43/t/02-pod.t000644 000765 000024 00000000201 11567522060 015335 0ustar00alstaff000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Net-LDAP-Server-0.43/t/03-podcoverage.t000644 000765 000024 00000000241 11567522112 017054 0ustar00alstaff000000 000000 use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); Net-LDAP-Server-0.43/lib/Net/000755 000765 000024 00000000000 11567522742 015216 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/lib/Net/LDAP/000755 000765 000024 00000000000 11567522742 015736 5ustar00alstaff000000 000000 Net-LDAP-Server-0.43/lib/Net/LDAP/Server.pm000644 000765 000024 00000020635 11567522646 017553 0ustar00alstaff000000 000000 # =========================================================================== # Net::LDAP::Server # # LDAP server side protocol handling # # Alessandro Ranellucci # Hans Klunder # 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; use Data::Dumper; our $VERSION = '0.43'; use fields qw(in out); 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, $input, $output) = @_; my $class = ref($proto) || $proto; my $self = fields::new($class); #print STDERR Dumper($input); #print STDERR Dumper($output); $self->{in} = $input; $self->{out} = $output || $input; return $self; } sub handle { my Net::LDAP::Server $self = shift; my $in = $self->{in}; my $out = $self->{out}; #print STDERR Dumper($in); #print STDERR Dumper($out); asn_read($in, 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"; #print Dumper($request); my $reqType; foreach my $type (@reqTypes) { if (defined $request->{$type}) { $reqType = $type; last; } } return 1 if !exists $respTypes{$reqType}; # unknown request type: let's hangup my $respType = $respTypes{$reqType}; # here we can do something with the request of type $reqType my $reqData = $request->{$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 $out $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 $out &_encode_result($mid, $respType, $result) if $respType; 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; # or with distinct input and output handles package main; my $handler = MyServer->new( $input_handle, $output_handle ); $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 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 =item C =item C =item C =item C =item C =item C =item C =item C =back For any method that is not supplied, Net::LDAP::Server will return an C. =head2 new() You can also subclass the C 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 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, 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 or I parts) =back You can look at L or use L 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 where the errorMessage will specify what went wrong. All methods should return a LDAPresult hashref, for example: return({ 'matchedDN' => '', 'errorMessage' => '', 'resultCode' => LDAP_SUCCESS }); C 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 or L 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; Or, alternatively, you can pass two handles for input and output, respectively. my $handler = MyServer->new(*STDIN{IO},*STDOUT{IO}); $handler->handle; See examples in I directory for sample servers, using L, L or L. =head1 DEPENDENCIES Net::LDAP::ASN Net::LDAP::Constant =head1 SEE ALSO =over 4 =item L =item Examples in C 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 Eaar@cpan.orgE The original author of a Net::LDAP::Daemon module is Hans Klunder Ehans.klunder@bigfoot.comE =cut Net-LDAP-Server-0.43/examples/forking-server.pl000644 000765 000024 00000000771 11567522112 021034 0ustar00alstaff000000 000000 #!/usr/bin/perl use strict; use warnings; package Listener; use Net::Daemon; use base 'Net::Daemon'; use MyDemoServer; sub Run { my $self = shift; my $handler = MyDemoServer->new($self->{socket}); while (1) { my $finished = $handler->handle; if ($finished) { # we have finished with the socket $self->{socket}->close; return; } } } package main; my $listener = Listener->new({ localport => 8080, logfile => 'STDERR', pidfile => 'none', mode => 'fork' }); $listener->Bind; 1; Net-LDAP-Server-0.43/examples/MyDemoServer.pm000644 000765 000024 00000004312 11567522112 020446 0ustar00alstaff000000 000000 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; Net-LDAP-Server-0.43/examples/simple-server.pl000644 000765 000024 00000001222 11567522112 020656 0ustar00alstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use IO::Select; use IO::Socket; use MyDemoServer; my $sock = IO::Socket::INET->new( Listen => 5, Proto => 'tcp', Reuse => 1, LocalPort => 8080 ); my $sel = IO::Select->new($sock); my %Handlers; while (my @ready = $sel->can_read) { foreach my $fh (@ready) { if ($fh == $sock) { # let's create a new socket my $psock = $sock->accept; $sel->add($psock); $Handlers{*$psock} = MyDemoServer->new($psock); } else { my $result = $Handlers{*$fh}->handle; if ($result) { # we have finished with the socket $sel->remove($fh); $fh->close; delete $Handlers{*$fh}; } } } } 1;