Permalink
Browse files

Initial import (pre-0.4)

git-svn-id: svn://localhost:3690/Net-LDAP-Server/trunk@2 79e93f9f-6f84-dc11-8383-000bcdcb7a8f
  • Loading branch information...
1 parent 1f665ff commit 60178893bf17af2cd165219f46666a98b1b26631 al committed Oct 27, 2007
Showing with 662 additions and 0 deletions.
  1. +1 −0 .shipit
  2. +19 −0 Changelog
  3. +12 −0 MANIFEST
  4. +11 −0 META.yml
  5. +14 −0 Makefile.PL
  6. +57 −0 README
  7. +106 −0 examples/MyDemoServer.pm
  8. +34 −0 examples/forking-server.pl
  9. +38 −0 examples/simple-server.pl
  10. +349 −0 lib/Net/LDAP/Server.pm
  11. +13 −0 t/01-use.t
  12. +4 −0 t/02-pod.t
  13. +4 −0 t/03-podcoverage.t
View
1 .shipit
@@ -0,0 +1 @@
+steps = MakeDist, UploadCPAN
View
19 Changelog
@@ -0,0 +1,19 @@
+CHANGELOG
+=========
+
+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
View
12 MANIFEST
@@ -0,0 +1,12 @@
+Changelog
+examples/forking-server.pl
+examples/MyDemoServer.pm
+examples/simple-server.pl
+lib/Net/LDAP/Server.pm
+Makefile.PL
+MANIFEST This list of files
+README
+t/01-use.t
+t/02-pod.t
+t/03-podcoverage.t
+META.yml Module meta-data (added by MakeMaker)
View
11 META.yml
@@ -0,0 +1,11 @@
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Net-LDAP-Server
+version: 0.3
+version_from: lib/Net/LDAP/Server.pm
+installdirs: site
+requires:
+ Net::LDAP: 0
+ Convert::ASN1: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.12
View
14 Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Net::LDAP::Server',
+ 'ABSTRACT' => 'LDAP server side protocol handling',
+ 'AUTHOR' => 'Alessandro Ranellucci <aar@cpan.org>',
+ 'VERSION_FROM' => 'lib/Net/LDAP/Server.pm',
+ 'PMLIBDIRS' => [ 'lib' ],
+ 'PREREQ_PM' => {
+ Net::LDAP => 0,
+ Convert::ASN1 => 0
+ },
+ 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' }
+);
View
57 README
@@ -0,0 +1,57 @@
+--------
+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<handle> 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,
+<ftp://ftp.cpan.org/pub/CPAN/authors/id/A/AA/AAR/>, 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
View
106 examples/MyDemoServer.pm
@@ -0,0 +1,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;
View
34 examples/forking-server.pl
@@ -0,0 +1,34 @@
+#!/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;
View
38 examples/simple-server.pl
@@ -0,0 +1,38 @@
+#!/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;
View
349 lib/Net/LDAP/Server.pm
@@ -0,0 +1,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
View
13 t/01-use.t
@@ -0,0 +1,13 @@
+#!/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;
View
4 t/02-pod.t
@@ -0,0 +1,4 @@
+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();
View
4 t/03-podcoverage.t
@@ -0,0 +1,4 @@
+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();

0 comments on commit 6017889

Please sign in to comment.