Net-LDAP-Server-0.4/0000755000076500001200000000000010710611141013556 5ustar aladmin00000000000000Net-LDAP-Server-0.4/Changelog0000644000076500001200000000060210710604132015370 0ustar aladmin00000000000000CHANGELOG ========= 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.4/examples/0000755000076500001200000000000010710611141015374 5ustar aladmin00000000000000Net-LDAP-Server-0.4/examples/forking-server.pl0000644000076500001200000000077110710604132020703 0ustar aladmin00000000000000#!/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.4/examples/MyDemoServer.pm0000644000076500001200000000437310710604132020324 0ustar aladmin00000000000000package 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; Net-LDAP-Server-0.4/examples/simple-server.pl0000644000076500001200000000122210710604132020525 0ustar aladmin00000000000000#!/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; Net-LDAP-Server-0.4/lib/0000755000076500001200000000000010710611141014324 5ustar aladmin00000000000000Net-LDAP-Server-0.4/lib/Net/0000755000076500001200000000000010710611141015052 5ustar aladmin00000000000000Net-LDAP-Server-0.4/lib/Net/LDAP/0000755000076500001200000000000010710611141015572 5ustar aladmin00000000000000Net-LDAP-Server-0.4/lib/Net/LDAP/Server.pm0000644000076500001200000001761410710611127017413 0ustar aladmin00000000000000# =========================================================================== # 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; 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 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; See examples in I directory for sample servers, using L or L. =head1 DEPENDENCIES Net::LDAP::ASN Net::LDAP::Constant =head1 SEE ALSO =over 4 =item L =item Examples in I 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.4/Makefile.PL0000644000076500001200000000062610710604132015536 0ustar aladmin00000000000000use ExtUtils::MakeMaker; 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' } ); Net-LDAP-Server-0.4/._MANIFEST0000644000076500000000000000026110710610425015140 0ustar alwheel00000000000000Mac OS X  2±ATTRŸ±˜˜com.macromates.caret{column = 13; line = 7; }Net-LDAP-Server-0.4/MANIFEST0000644000076500001200000000044510710610425014716 0ustar aladmin00000000000000Changelog 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 README t/01-use.t t/02-pod.t t/03-podcoverage.t META.yml Module meta-data (added by MakeMaker) Net-LDAP-Server-0.4/MANIFEST.SKIP0000644000076500001200000000073610710610320015460 0ustar aladmin00000000000000makedocs.pl \.shipit \.brackup$ # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\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.4/META.yml0000644000076500001200000000060310710611141015026 0ustar aladmin00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-LDAP-Server version: 0.4 version_from: lib/Net/LDAP/Server.pm installdirs: site requires: Convert::ASN1: 0 Net::LDAP: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Net-LDAP-Server-0.4/README0000644000076500001200000000254310710604132014444 0ustar aladmin00000000000000-------- 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.4/t/0000755000076500001200000000000010710611141014021 5ustar aladmin00000000000000Net-LDAP-Server-0.4/t/01-use.t0000644000076500001200000000025010710604132015217 0ustar aladmin00000000000000#!/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.4/t/02-pod.t0000644000076500001200000000020110710604132015202 0ustar aladmin00000000000000use 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.4/t/03-podcoverage.t0000644000076500001200000000024110710604132016723 0ustar aladmin00000000000000use 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();