Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Multiple Changes

Small fixes
- fixed copyright date
- lost common sense
- some cleanup in useless comments
- added ldapd.pl script
- changed option name from 'ldap_data' to 'data_file'
- changed server basedir to {home}/.ldapsimple
- log file goes into {basedir}/server.log by default,
  with no additional directory level
- changed default configuration file to {basedir}/server.conf
- added option 'allow_anon' to control whether the server accepts anonymous
  binds or not

Improved tests
- added ldif file with multiple entries for testing
- changed server log path in all tests to /tmp/ldapserver.log
- renamed test files
- fixed t/03-param.t -> t/13-param.t
-- more tests
-- better test logic (functions server_ok() and server_nok())
-- added test names
- fixing t/04-bind.t -> t/14-bind.t
-- replace 'use constant' with variables
-- improved test messages
- test for unsupported authentication mechanism
- refactored common test code to t/lib/Helper.pm

SimpleServer.pm
- adding Net::Server to @ISA, rather than assigning it
- using variables rather than constants
- only creates a store if one is not provided

ProtocolHandler
- improved invokation style for the constructor - now everything goes inside
  the hash reference
- explicitly exporting the symbols from Net::LDAP::Constant
- improved error mesages
- added option 'allow_anon' to control whether to accept anonymous binds

Tidy

Work still in progress ...

Signed-off-by: Alexei Znamensky <russoz@cpan.org>
  • Loading branch information...
commit 58f60bd96f40c3ca9d1d61e3c5451ba92bf772d3 1 parent c6aaacb
Alexei Znamensky russoz authored
32 bin/ldapd.pl
... ... @@ -0,0 +1,32 @@
  1 +#!/usr/bin/env perl
  2 +
  3 +use strict;
  4 +use warnings;
  5 +
  6 +# PODNAME: ldapd.pl
  7 +# ABSTRACT: Script to invoke the LDAP server.
  8 +
  9 +# VERSION
  10 +
  11 +use Net::LDAP::SimpleServer;
  12 +
  13 +my $server =
  14 + @ARGV
  15 + ? Net::LDAP::SimpleServer->new( {@ARGV} )
  16 + : Net::LDAP::SimpleServer->new;
  17 +
  18 +$server->run();
  19 +
  20 +__END__
  21 +
  22 +=head1 SYNOPSIS
  23 +
  24 + host:~ # ldapd.pl
  25 +
  26 +=head1 DESCRIPTION
  27 +
  28 +This script simply instantiates and executes a L<Net::LDAP::SimpleServer>
  29 +server.
  30 +
  31 +=cut
  32 +
2  dist.ini
@@ -2,7 +2,7 @@ name = Net-LDAP-SimpleServer
2 2 author = Alexei Znamensky <russoz@cpan.org>
3 3 license = Perl_5
4 4 copyright_holder = Alexei Znamensky
5   -copyright_year = 2011
  5 +copyright_year = 2012
6 6
7 7 [@Author::RUSSOZ]
8 8 version = gitnext
4 examples/empty.conf
... ... @@ -1,5 +1,3 @@
1   -#-------------- file test.conf --------------
2   -
3 1 ### user and group to become
4 2 #user somebody
5 3 #group everybody
@@ -37,5 +35,3 @@
37 35 ### reverse lookups ?
38 36 # reverse_lookups on
39 37
40   -#-------------- file test.conf --------------
41   -
43 examples/multi-entries.ldif
... ... @@ -0,0 +1,43 @@
  1 +version: 1
  2 +
  3 +dn: CN=John Doe,OU=Marketing,DC=Company,DC=com
  4 +objectClass: top
  5 +objectClass: person
  6 +objectClass: organizationalPerson
  7 +objectClass: user
  8 +cn: John Doe
  9 +description: Consultant - Company.com
  10 +displayName: Joe Doe
  11 +distinguishedName: CN=John Doe,OU=Marketing,DC=Company,DC=com
  12 +givenName: John
  13 +manager: CN=Jack Puppetmeister,OU=Marketing,DC=Company,DC=com
  14 +name: John Doe
  15 +sn: Doe
  16 +
  17 +dn: CN=Sarah Lee,OU=Marketing,DC=Company,DC=com
  18 +objectClass: top
  19 +objectClass: person
  20 +objectClass: organizationalPerson
  21 +objectClass: user
  22 +cn: Sarah Lee
  23 +description: Consultant - Company.com
  24 +displayName: Sarah Lee
  25 +distinguishedName: CN=Sarah Lee,OU=Marketing,DC=Company,DC=com
  26 +givenName: Sarah
  27 +manager: CN=Jack Puppetmeister,OU=Marketing,DC=Company,DC=com
  28 +name: Sarah Lee
  29 +sn: Lee
  30 +
  31 +dn: CN=Robert Sponge,OU=Marketing,DC=Company,DC=com
  32 +objectClass: top
  33 +objectClass: person
  34 +objectClass: organizationalPerson
  35 +objectClass: user
  36 +cn: Robert Sponge
  37 +description: Consultant - Company.com
  38 +displayName: Bob Sponge
  39 +distinguishedName: CN=Robert Sponge,OU=Marketing,DC=Company,DC=com
  40 +givenName: Robert
  41 +manager: CN=John Doe,OU=Marketing,DC=Company,DC=com
  42 +name: Robert Sponge
  43 +sn: Sponge
4 examples/single-entry.conf
... ... @@ -1,12 +1,12 @@
1 1
2   -ldap_data examples/single-entry.ldif
  2 +data_file examples/single-entry.ldif
3 3
4 4 ### user and group to become
5 5 #user somebody
6 6 #group everybody
7 7
8 8 ### logging ?
9   -#log_file /var/log/server.log
  9 +log_file /tmp/ldapserver.log
10 10 #log_level 3
11 11 #pid_file /tmp/server.pid
12 12
112 lib/Net/LDAP/SimpleServer.pm
@@ -9,7 +9,6 @@ use warnings;
9 9
10 10 use 5.008;
11 11 use Carp;
12   -use common::sense;
13 12
14 13 our $personality = undef;
15 14
@@ -17,11 +16,10 @@ sub import {
17 16 my $pkg = shift;
18 17 $personality = shift || 'Fork';
19 18
20   - use Net::Server;
21 19 eval "use base qw{Net::Server::$personality}"; ## no critic
22 20 croak $@ if $@;
23 21
24   - @Net::LDAP::SimpleServer::ISA = qw(Net::Server);
  22 + push @Net::LDAP::SimpleServer::ISA, qw(Net::Server);
25 23
26 24 #use Data::Dumper;
27 25 #print STDERR Data::Dumper->Dump( [ \@Net::LDAP::SimpleServer::ISA ],
@@ -37,35 +35,30 @@ use Scalar::Util qw{reftype};
37 35 use Net::LDAP::SimpleServer::LDIFStore;
38 36 use Net::LDAP::SimpleServer::ProtocolHandler;
39 37
40   -## no critic
41   -use constant BASEDIR => File::Spec->catfile( home(), '.ldapsimpleserver' );
42   -use constant LOGDIR => File::Spec->catfile( BASEDIR, 'log' );
43   -use constant DEFAULT_CONFIG_FILE => File::Spec->catfile( BASEDIR, 'config' );
44   -use constant DEFAULT_DATA_FILE => File::Spec->catfile( BASEDIR, 'server.ldif' );
45   -## use critic
  38 +my $BASEDIR = File::Spec->catfile( home(), '.ldapsimple' );
  39 +my $DEFAULT_CONFIG_FILE = File::Spec->catfile( $BASEDIR, 'server.conf' );
  40 +my $DEFAULT_DATA_FILE = File::Spec->catfile( $BASEDIR, 'server.ldif' );
46 41
47   -make_path(LOGDIR);
  42 +my @LDAP_PRIVATE_OPTIONS = ( 'store', 'input', 'output' );
  43 +my @LDAP_PUBLIC_OPTIONS = ( 'data_file', 'root_dn', 'root_pw', 'allow_anon' );
48 44
49   -my $_add_option = sub {
50   - my ( $template, $prop, $opt, $initial ) = @_;
51   -
52   - $prop->{$opt} = $initial;
53   - $template->{$opt} = \$prop->{$opt};
54   -};
  45 +make_path($BASEDIR);
55 46
56 47 sub options {
57 48 my ( $self, $template ) = @_;
  49 + my $prop = $self->{server};
  50 +
58 51 ### setup options in the parent classes
59 52 $self->SUPER::options($template);
60 53
61 54 ### add a single value option
62   - my $prop = $self->{server};
63   - $_add_option->( $template, $prop, 'ldap_data', undef );
64   - $_add_option->( $template, $prop, 'root_dn', undef );
65   - $_add_option->( $template, $prop, 'root_pw', undef );
  55 + for (@LDAP_PUBLIC_OPTIONS) {
  56 + $prop->{$_} = undef unless exists $prop->{$_};
  57 + $template->{$_} = \$prop->{$_};
  58 + }
66 59
67 60 #use Data::Dumper;
68   - #print STDERR Data::Dumper->Dump( [$self], ['options_END'] );
  61 + #print STDERR Data::Dumper->Dump( [$self->{server}], ['server'] );
69 62 return;
70 63 }
71 64
@@ -73,61 +66,54 @@ sub default_values {
73 66 my $self = @_;
74 67
75 68 my $v = {};
76   - $v->{port} = 389;
77   - $v->{root_dn} = 'cn=root';
78   - $v->{root_pw} = 'ldappw';
79   - $v->{log_file} = File::Spec->catfile( LOGDIR, 'server.log' );
80   -
81   - #$v->{pid_file} = File::Spec->catfile( LOGDIR, 'server.pid' );
82   - $v->{conf_file} = DEFAULT_CONFIG_FILE if -r DEFAULT_CONFIG_FILE;
83   - $v->{ldap_data} = DEFAULT_DATA_FILE if -r DEFAULT_DATA_FILE;
  69 + $v->{port} = 389;
  70 + $v->{log_file} = File::Spec->catfile( $BASEDIR, 'server.log' );
  71 + $v->{conf_file} = $DEFAULT_CONFIG_FILE if -r $DEFAULT_CONFIG_FILE;
84 72 $v->{syslog_ident} =
85   - 'Net::LDAP::SimpleServer-' . $Net::LDAP::SimpleServer::VERSION;
86   - return $v;
87   -}
88   -
89   -sub _make_dir {
90   - my $file = shift;
91   - return unless $file;
  73 + 'Net::LDAP::SimpleServer [' . $Net::LDAP::SimpleServer::VERSION . ']';
92 74
93   - my $dir = dirname($file);
94   - return unless $dir;
95   - return if -d $dir;
  75 + $v->{allow_anon} = 1;
  76 + $v->{root_dn} = 'cn=root';
  77 + $v->{data_file} = $DEFAULT_DATA_FILE if -r $DEFAULT_DATA_FILE;
96 78
97   - make_path($dir);
98   - return;
  79 + #use Data::Dumper; print STDERR Dumper($v);
  80 + return $v;
99 81 }
100 82
101 83 sub post_configure_hook {
102 84 my $self = shift;
103 85 my $prop = $self->{server};
104 86
105   - #use Data::Dumper;
106   - #print STDERR '# ' . Data::Dumper->Dump( [$self], ['post_configure_hook'] );
107   - croak q{Cannot find conf file "} . $self->{server}->{conf_file} . q{"}
108   - if $self->{server}->{conf_file} and not -r $self->{server}->{conf_file};
109   - _make_dir( $self->{server}->{log_file} );
110   - _make_dir( $self->{server}->{pid_file} );
111   - croak q{Configuration has no "ldap_data" file!}
112   - unless exists $prop->{ldap_data};
113   - croak qq{Cannot read ldap_data file "} . $prop->{ldap_data} . q{"}
114   - unless -r $prop->{ldap_data};
  87 + # create server directory in home dir
  88 + make_path($BASEDIR);
  89 +
  90 + #use Data::Dumper; print STDERR '# ' . Dumper( $prop );
  91 + croak q{Cannot read configuration file (} . $prop->{conf_file} . q{)}
  92 + if ( $prop->{conf_file} && !-r $prop->{conf_file} );
  93 + croak q{Configuration has no "data_file" file!}
  94 + unless $prop->{data_file};
  95 + croak qq{Cannot read data_file file (} . $prop->{data_file} . q{)}
  96 + unless -r $prop->{data_file};
115 97
  98 + # data_file is not a "public" option in the server, it is created here
116 99 $prop->{store} =
117   - Net::LDAP::SimpleServer::LDIFStore->new( $prop->{ldap_data} )
  100 + Net::LDAP::SimpleServer::LDIFStore->new( $prop->{data_file} )
118 101 || croak q{Cannot create data store!};
  102 +
119 103 return;
120 104 }
121 105
122 106 sub process_request {
123 107 my $self = shift;
  108 + my $prop = $self->{server};
124 109
125   - my $in = *STDIN{IO};
126   - my $out = *STDOUT{IO};
127   - my $params =
128   - { map { ( $_ => $self->{server}->{$_} ) } qw/store root_dn root_pw/ };
129   - my $handler =
130   - Net::LDAP::SimpleServer::ProtocolHandler->new( $params, $in, $out );
  110 + my $params = { map { ( $_ => $prop->{$_} ) } @LDAP_PUBLIC_OPTIONS };
  111 + for (@LDAP_PRIVATE_OPTIONS) {
  112 + $params->{$_} = $prop->{$_} if $prop->{$_};
  113 + }
  114 + $params->{input} = *STDIN{IO};
  115 + $params->{output} = *STDOUT{IO};
  116 + my $handler = Net::LDAP::SimpleServer::ProtocolHandler->new($params);
131 117
132 118 until ( $handler->handle ) {
133 119
@@ -142,8 +128,6 @@ __END__
142 128
143 129 =head1 SYNOPSIS
144 130
145   - package MyServer;
146   -
147 131 use Net::LDAP::SimpleServer;
148 132
149 133 # Or, specifying a Net::Server personality
@@ -160,7 +144,7 @@ __END__
160 144 # passing configurations in a hash
161 145 my $server = Net::LDAP::SimpleServer->new({
162 146 port => 5000,
163   - ldap_data => '/path/to/data.ldif',
  147 + data_file => '/path/to/data.ldif',
164 148 });
165 149
166 150 # make it spin
@@ -202,7 +186,7 @@ server, namely:
202 186
203 187 =over
204 188
205   -ldap_data - the LDIF data file used by LDIFStore
  189 +data_file - the LDIF data file used by LDIFStore
206 190
207 191 root_dn - the administrator DN of the repository
208 192
@@ -224,7 +208,7 @@ number of options. In Net::LDAP::SimpleServer, this method is defined as:
224 208 root_pw => 'ldappw',
225 209 syslog_ident => 'Net::LDAP::SimpleServer-'
226 210 . $Net::LDAP::SimpleServer::VERSION,
227   - conf_file => DEFAULT_CONFIG_FILE,
  211 + conf_file => $DEFAULT_CONFIG_FILE,
228 212 };
229 213 }
230 214
@@ -249,7 +233,7 @@ server settings. If no file is specified and options are not passed
249 233 in a hash, this module will look for a default configuration file named
250 234 C<< ${HOME}/.ldapsimpleserver/config >>.
251 235
252   - ldap_data /path/to/a/ldif/file.ldif
  236 + data_file /path/to/a/ldif/file.ldif
253 237 #port 389
254 238 #root_dn cn=root
255 239 #root_pw somepassword
1  lib/Net/LDAP/SimpleServer/LDIFStore.pm
@@ -2,7 +2,6 @@ package Net::LDAP::SimpleServer::LDIFStore;
2 2
3 3 use strict;
4 4 use warnings;
5   -use diagnostics;
6 5
7 6 # ABSTRACT: Data store to support Net::LDAP::SimpleServer
8 7
80 lib/Net/LDAP/SimpleServer/ProtocolHandler.pm
@@ -3,40 +3,28 @@ package Net::LDAP::SimpleServer::ProtocolHandler;
3 3 use strict;
4 4 use warnings;
5 5
6   -use common::sense;
7   -
8 6 # ABSTRACT: LDAP protocol handler used with Net::LDAP::SimpleServer
9 7
10 8 # VERSION
11 9
12 10 use Net::LDAP::Server;
13 11 use base 'Net::LDAP::Server';
14   -use fields qw(store root_dn root_pw);
  12 +use fields qw(store root_dn root_pw allow_anon);
15 13
16 14 use Carp;
17 15 use Net::LDAP::LDIF;
18 16 use Net::LDAP::Util qw{canonical_dn};
19 17 use Net::LDAP::FilterMatch;
20 18
21   -use Scalar::Util qw{blessed reftype looks_like_number};
  19 +use Net::LDAP::Constant (
  20 + qw/LDAP_SUCCESS LDAP_AUTH_UNKNOWN LDAP_INVALID_CREDENTIALS/,
  21 + qw/LDAP_AUTH_METHOD_NOT_SUPPORTED/ );
  22 +
  23 +use Scalar::Util qw{reftype};
22 24 use UNIVERSAL::isa;
23 25
24 26 use Data::Dumper;
25 27
26   -my %_ldap_cache = ();
27   -
28   -sub _get_ldap_constant {
29   - my $code = shift;
30   - return $code if looks_like_number($code);
31   - return $_ldap_cache{$code} if exists $_ldap_cache{$code};
32   - ## no critic
33   - return $_ldap_cache{$code} = eval qq{
34   - use Net::LDAP::Constant qw|$code|;
35   - $code;
36   - };
37   - ## use critic
38   -}
39   -
40 28 sub _make_result {
41 29 my $code = shift;
42 30 my $dn = shift || '';
@@ -45,31 +33,29 @@ sub _make_result {
45 33 return {
46 34 matchedDN => $dn,
47 35 errorMessage => $msg,
48   - resultCode => _get_ldap_constant($code),
  36 + resultCode => $code,
49 37 };
50 38 }
51 39
52 40 sub new {
53 41 my $class = shift;
54   - my $params = shift;
55   - my $self = $class->SUPER::new(@_);
  42 + my $params = shift || croak 'Must pass parameters!';
  43 + my $self = $class->SUPER::new( $params->{input}, $params->{output} );
56 44
57   - croak 'First parameter must be an ARRAYREF'
58   - unless reftype($params) eq 'HASH';
59   -
60   - croak 'Must pass store!' unless exists $params->{store};
61   - croak 'Not an object!' unless blessed( $params->{store} );
62   - croak 'Not a LDIFStore!'
  45 + croak 'Parameter must be a HASHREF' unless reftype($params) eq 'HASH';
  46 + croak 'Must pass option {store}' unless exists $params->{store};
  47 + croak 'Not a LDIFStore'
63 48 unless $params->{store}->isa('Net::LDAP::SimpleServer::LDIFStore');
64 49
65   - croak 'Must pass root_dn!' unless exists $params->{root_dn};
66   -
  50 + croak 'Must pass option {root_dn}' unless exists $params->{root_dn};
  51 + croak 'Option {root_dn} can not be empty' unless $params->{root_dn};
67 52 croak 'Invalid root DN'
68 53 unless my $canon_dn = canonical_dn( $params->{root_dn} );
69 54
70 55 $self->{store} = $params->{store};
71 56 $self->{root_dn} = $canon_dn;
72   - $self->{root_pw} = $params->{root_pw} || '';
  57 + $self->{root_pw} = $params->{root_pw};
  58 + $self->{allow_anon} = $params->{allow_anon};
73 59 chomp( $self->{root_pw} );
74 60
75 61 return $self;
@@ -82,36 +68,33 @@ sub unbind {
82 68 $self->{root_dn} = undef;
83 69 $self->{root_pw} = undef;
84 70
85   - return _make_result(qw/LDAP_SUCCESS/);
  71 + return _make_result(LDAP_SUCCESS);
86 72 }
87 73
88 74 sub bind { ## no critic
89   -
90   - # my $r = _bind(@_);
91   - # print STDERR q{response = } . Dumper($r);
92   - # return $r;
93   - #}
94   - #
95   - #sub _bind {
96 75 my ( $self, $request ) = @_;
97 76
98 77 #print STDERR '=' x 70 . "\n";
  78 + #print STDERR Dumper($self);
99 79 #print STDERR Dumper($request);
100   - my $ok = _make_result(qw/LDAP_SUCCESS/);
101   - return $ok unless $request->{name};
  80 + my $ok = _make_result(LDAP_SUCCESS);
  81 +
  82 + if( not $request->{name} and exists $request->{authentication}->{simple} and $self->{allow_anon} ) {
  83 + return $ok;
  84 + }
102 85
103 86 #print STDERR qq{not anonymous\n};
104 87 # As of now, accepts only simple authentication
105   - return _make_result(qw/LDAP_AUTH_UNKNOWN/)
  88 + return _make_result(LDAP_AUTH_METHOD_NOT_SUPPORTED)
106 89 unless exists $request->{authentication}->{simple};
107 90
108 91 #print STDERR qq{is simple authentication\n};
109   - return _make_result(qw/LDAP_INVALID_CREDENTIALS/)
  92 + return _make_result(LDAP_INVALID_CREDENTIALS)
110 93 unless my $binddn = canonical_dn( $request->{name} );
111 94
112 95 #print STDERR qq#binddn is ok ($request->{name}) => ($binddn)\n#;
113 96 #print STDERR qq#handler dn is $self->{root_dn}\n#;
114   - return _make_result(qw/LDAP_INVALID_CREDENTIALS/)
  97 + return _make_result(LDAP_INVALID_CREDENTIALS)
115 98 unless uc($binddn) eq uc( $self->{root_dn} );
116 99
117 100 #print STDERR qq{binddn is good\n};
@@ -119,7 +102,7 @@ sub bind { ## no critic
119 102 chomp($bindpw);
120 103
121 104 #print STDERR qq|comparing ($bindpw) eq ($self->{root_pw})\n|;
122   - return _make_result(qw/LDAP_INVALID_CREDENTIALS/)
  105 + return _make_result(LDAP_INVALID_CREDENTIALS)
123 106 unless $bindpw eq $self->{root_pw};
124 107
125 108 return $ok;
@@ -135,20 +118,23 @@ sub _match {
135 118 sub search {
136 119 my ( $self, $request ) = @_;
137 120
138   - my $list = $self->{store}->list;
139   - my $basedn = $request->{baseObject};
  121 + my $list = $self->{store}->list;
  122 +
  123 + #my $basedn = $request->{baseObject};
140 124
141 125 #print STDERR '=' x 50 . "\n";
142 126 #print STDERR Dumper($request);
143 127 #print STDERR Dumper($list);
144 128
145 129 my $res = _match( $request->{filter}, $list );
  130 +
146 131 #print STDERR Dumper($res);
147 132
148   - return ( _make_result(qw/LDAP_SUCCESS/), @{$res} );
  133 + return ( _make_result(LDAP_SUCCESS), @{$res} );
149 134 }
150 135
151 136 1; # Magic true value required at end of module
  137 +
152 138 __END__
153 139
154 140 =head1 SYNOPSIS
69 t/03-param.t
... ... @@ -1,69 +0,0 @@
1   -use Test::More tests => 6;
2   -
3   -use Proc::Fork;
4   -use IO::Pipe;
5   -
6   -$alarm_wait = 5;
7   -
8   -sub _eval_param {
9   - my @a = @_;
10   - my $result = undef;
11   -
12   - $p = IO::Pipe->new;
13   -
14   - run_fork {
15   - child {
16   - $p->writer;
17   - sub quit { print $p shift; exit; }
18   -
19   - alarm 0;
20   - local $SIG{ALRM} = sub { quit('OK') };
21   - alarm $alarm_wait;
22   -
23   - eval {
24   - use Net::LDAP::SimpleServer qw{Fork};
25   -
26   - # passing custom options in the construtor does not seem to
27   - # work with Net::Server, thus we pass them in run()
28   - my $s = Net::LDAP::SimpleServer->new();
29   -
30   - $s->run(@a);
31   - };
32   -
33   - quit('NOK');
34   - }
35   - };
36   -
37   - # parent code
38   - $p->reader;
39   - $result = <$p>;
40   -
41   - #diag( 'got result: ' . $result );
42   - return $result eq 'OK';
43   -}
44   -
45   -diag('Testing the constructor params for SimpleServer');
46   -
47   -# expect failure
48   -ok( !_eval_param() );
49   -ok( !_eval_param( {} ) );
50   -
51   -# Cannot test for non-existent configuration file right now
52   -# because Net::Server calls exit() when that happens >:-\
53   -#
54   -#_eval_param( { conf_file => 'examples/no/file.conf' } );
55   -ok( !_eval_param( { ldap_data => 'examples/test1.ldif' } ) );
56   -ok( !_eval_param( { conf_file => 'examples/empty.conf' } ) );
57   -
58   -# ===========================================================================
59   -# expect success
60   -ok(
61   - _eval_param(
62   - {
63   - port => 20000,
64   - ldap_data => 'examples/single-entry.ldif',
65   - }
66   - )
67   -);
68   -ok( _eval_param( { conf_file => 'examples/single-entry.conf' } ) );
69   -
87 t/04-bind.t
... ... @@ -1,87 +0,0 @@
1   -use Test::More tests => 9;
2   -
3   -use Proc::Fork;
4   -use Net::LDAP;
5   -use Net::LDAP::SimpleServer;
6   -
7   -use Data::Dumper;
8   -
9   -use constant TESTHOST => 'localhost';
10   -use constant TESTPORT => 10389;
11   -use constant TESTDATA => 'examples/single-entry.ldif';
12   -use constant TESTROOTDN => 'cn=root';
13   -use constant TESTROOTPW => 'testpw';
14   -
15   -#sub diag { print STDERR @_; }
16   -
17   -sub ldapconnect {
18   - return Net::LDAP->new( TESTHOST, port => TESTPORT );
19   -}
20   -
21   -sub run_test {
22   - my $mesg = undef;
23   -
24   - my $ldap = ldapconnect();
25   - ok($ldap);
26   -
27   - diag('Binding anonymously');
28   - $mesg = $ldap->bind;
29   - ok( !$mesg->code, $mesg->error_desc );
30   -
31   - $mesg = $ldap->unbind;
32   - ok( !$mesg->code, $mesg->error_desc );
33   -
34   - diag('Binding with authentication');
35   - $ldap = ldapconnect();
36   - $mesg = $ldap->bind( TESTROOTDN, password => TESTROOTPW );
37   - ok( !$mesg->code, $mesg->error_desc );
38   -
39   - $mesg = $ldap->unbind;
40   - ok( !$mesg->code, $mesg->error_desc );
41   -
42   - diag('Upper case bind DN');
43   - $ldap = ldapconnect();
44   - $mesg = $ldap->bind( uc(TESTROOTDN), password => TESTROOTPW );
45   - ok( !$mesg->code, $mesg->error_desc );
46   -
47   - $mesg = $ldap->unbind;
48   - ok( !$mesg->code, $mesg->error_desc );
49   -
50   - diag('Wrong password -> no bind');
51   - $ldap = ldapconnect();
52   - $mesg = $ldap->bind( TESTROOTDN, password => 'some-wrong-password' );
53   - ok( $mesg->code, $mesg->error_desc );
54   -
55   - diag('Unbinding');
56   - $mesg = $ldap->unbind;
57   - ok( !$mesg->code, $mesg->error_desc );
58   -
59   -}
60   -
61   -run_fork {
62   - parent {
63   - my $child = shift;
64   -
65   - # give the server some time to start
66   - sleep 10;
67   -
68   - # run client
69   - run_test();
70   - kill 15, $child;
71   - }
72   - child {
73   - my $s = Net::LDAP::SimpleServer->new();
74   -
75   - # run server
76   - diag('Starting Net::LDAP::SimpleServer [Fork]');
77   - $s->run(
78   - {
79   - port => TESTPORT,
80   - ldap_data => TESTDATA,
81   - root_pw => TESTROOTPW,
82   - }
83   - );
84   - diag('Server has quit');
85   - }
86   -};
87   -
0  t/02-handler.t → t/05-handler.t
File renamed without changes
77 t/05-search.t
... ... @@ -1,77 +0,0 @@
1   -use Test::More tests => 9;
2   -
3   -use Proc::Fork;
4   -use Net::LDAP;
5   -use Net::LDAP::SimpleServer;
6   -
7   -use Data::Dumper;
8   -
9   -use constant TESTHOST => 'localhost';
10   -use constant TESTPORT => 10389;
11   -use constant TESTDATA => 'examples/single-entry.ldif';
12   -use constant TESTROOTDN => 'cn=root';
13   -use constant TESTROOTPW => 'testpw';
14   -
15   -sub ldapconnect {
16   - return Net::LDAP->new( TESTHOST, port => TESTPORT );
17   -}
18   -
19   -sub run_test {
20   - my $mesg = undef;
21   -
22   - my $ldap = ldapconnect();
23   - ok($ldap);
24   -
25   - $mesg = $ldap->bind;
26   - ok( !$mesg->code, $mesg->error_desc );
27   -
28   - # no results for this one
29   - $mesg = $ldap->search( base => 'DC=org', filter => '(dn=*)' );
30   - ok( !$mesg->code, $mesg->error_desc );
31   - my @entries = $mesg->entries;
32   - is( scalar @entries, 0 );
33   -
34   - my $dn1 =
35   - 'CN=Alexei Znamensky,OU=SnakeOil,OU=Extranet,DC=sa,DC=mynet,DC=net';
36   - $mesg = $ldap->search(
37   - base => 'DC=net',
38   - filter => '(distinguishedname=' . $dn1 . ')'
39   - );
40   - ok( !$mesg->code, $mesg->error_desc );
41   - @entries = $mesg->entries;
42   - is( scalar @entries, 1 );
43   - my $e = shift @entries;
44   - is( $e->dn, $dn1 );
45   - is( $e->get_value('sn'), 'Znamensky' );
46   -
47   - $mesg = $ldap->unbind;
48   - ok( !$mesg->code, $mesg->error_desc );
49   -}
50   -
51   -run_fork {
52   - parent {
53   - my $child = shift;
54   -
55   - # give the server some time to start
56   - sleep 10;
57   -
58   - # run client
59   - run_test();
60   - kill 15, $child;
61   - }
62   - child {
63   - my $s = Net::LDAP::SimpleServer->new();
64   -
65   - # run server
66   - diag('Starting Net::LDAP::SimpleServer [Fork]');
67   - $s->run(
68   - {
69   - port => TESTPORT,
70   - ldap_data => TESTDATA,
71   - root_pw => TESTROOTPW,
72   - }
73   - );
74   - diag('Server has quit');
75   - }
76   -};
77   -
0  t/02-store.t → t/06-store.t
File renamed without changes
57 t/13-param.t
... ... @@ -0,0 +1,57 @@
  1 +use Test::More tests => 10;
  2 +
  3 +use lib 't/lib';
  4 +use Helper qw(server_ok server_nok);
  5 +
  6 +# undef or empty hash
  7 +server_nok( undef, 'should not work without parameters' );
  8 +server_nok( {}, 'should not work with empty has as parameter' );
  9 +
  10 +# configuration file
  11 +diag('Net::Server error below:');
  12 +server_nok( { conf_file => '/no/such/file.conf' },
  13 + 'should not work with non-existing configuration file' );
  14 +server_nok(
  15 + { conf_file => 'examples/empty.conf' },
  16 + 'should not work with empty configuration file'
  17 +);
  18 +server_ok(
  19 + { conf_file => 'examples/single-entry.conf' },
  20 + 'should work with proper configuration file'
  21 +);
  22 +
  23 +# data file
  24 +server_nok(
  25 + { data_file => 'examples/test1.ldif' },
  26 + 'should not work with non-existing data file'
  27 +);
  28 +server_ok(
  29 + { data_file => 'examples/single-entry.ldif' },
  30 + 'should work with existing data file'
  31 +);
  32 +
  33 +# other tests
  34 +server_ok(
  35 + {
  36 + port => 20000,
  37 + data_file => 'examples/single-entry.ldif',
  38 + },
  39 + 'should work with proper data file and port'
  40 +);
  41 +server_nok(
  42 + {
  43 + host => 'localhost',
  44 + port => '10389',
  45 + root_pw => 'testpw',
  46 + }
  47 +);
  48 +server_ok(
  49 + {
  50 + host => 'localhost',
  51 + port => '10389',
  52 + data_file => 'examples/single-entry.ldif',
  53 + root_pw => 'testpw',
  54 + },
  55 + 'should work specifying different parameters'
  56 +);
  57 +
120 t/14-bind.t
... ... @@ -0,0 +1,120 @@
  1 +use Test::More tests => 15;
  2 +
  3 +use lib 't/lib';
  4 +use Helper qw(ldap_client test_requests);
  5 +
  6 +our $DATA = 'examples/single-entry.ldif';
  7 +our $ROOT_DN = 'cn=root';
  8 +our $ROOT_PW = 'testpw';
  9 +
  10 +#sub diag { print STDERR @_; }
  11 +
  12 +test_requests(
  13 + server_opts => {
  14 + data_file => $DATA,
  15 + root_pw => $ROOT_PW,
  16 + },
  17 + requests_sub => sub {
  18 + my $mesg = undef;
  19 +
  20 + my $ldap = ldap_client();
  21 + ok( $ldap, 'should be able to connect' );
  22 +
  23 + diag('Binding anonymously');
  24 + $mesg = $ldap->bind;
  25 + ok( !$mesg->code,
  26 + 'should be able to bind anonymously (' . $mesg->error_desc . ')' );
  27 +
  28 + $mesg = $ldap->unbind;
  29 + ok( !$mesg->code,
  30 + 'should be able to unbind (' . $mesg->error_desc . ')' );
  31 +
  32 + diag('Binding with authentication');
  33 + $ldap = ldap_client();
  34 + $mesg = $ldap->bind( $ROOT_DN, password => $ROOT_PW );
  35 + ok( !$mesg->code,
  36 + 'should be able to bind with authentication ('
  37 + . $mesg->error_desc
  38 + . ')' );
  39 +
  40 + $mesg = $ldap->unbind;
  41 + ok( !$mesg->code,
  42 + 'should be able to unbind (' . $mesg->error_desc . ')' );
  43 +
  44 + diag('Upper case bind DN');
  45 + $ldap = ldap_client();
  46 + $mesg = $ldap->bind( uc($ROOT_DN), password => $ROOT_PW );
  47 + ok( !$mesg->code,
  48 + 'should be able to bind with authentication in upper case('
  49 + . $mesg->error_desc
  50 + . ')' );
  51 +
  52 + $mesg = $ldap->unbind;
  53 + ok( !$mesg->code,
  54 + 'should be able to unbind (' . $mesg->error_desc . ')' );
  55 +
  56 + diag('Wrong password -> no bind');
  57 + $ldap = ldap_client();
  58 + $mesg = $ldap->bind( $ROOT_DN, password => 'some-wrong-password' );
  59 + ok( $mesg->code,
  60 + 'should not be able to bind with wrong password ('
  61 + . $mesg->error_desc
  62 + . ')' );
  63 +
  64 + $mesg = $ldap->unbind;
  65 + ok( !$mesg->code,
  66 + 'should be able to unbind (' . $mesg->error_desc . ')' );
  67 +
  68 + diag('Unsupported auth mechanism');
  69 + $ldap = ldap_client();
  70 + {
  71 + use Authen::SASL;
  72 + my $sasl = Authen::SASL->new(
  73 + mechanism => 'CRAM-MD5 PLAIN ANONYMOUS',
  74 + callback => {
  75 + pass => "blablabla",
  76 + user => "blablabla",
  77 + }
  78 + );
  79 + $mesg = $ldap->bind( $ROOT_DN, sasl => $sasl );
  80 + ok( $mesg->code,
  81 + 'should not be able to bind with SASL authentication ('
  82 + . $mesg->error_desc
  83 + . ')' );
  84 +
  85 + $mesg = $ldap->unbind;
  86 + ok( !$mesg->code,
  87 + 'should be able to unbind (' . $mesg->error_desc . ')' );
  88 + }
  89 + },
  90 +);
  91 +
  92 +test_requests(
  93 + server_opts => {
  94 + data_file => $DATA,
  95 + root_pw => $ROOT_PW,
  96 + allow_anon => 0,
  97 + },
  98 + requests_sub => sub {
  99 + my $ldap = ldap_client();
  100 + my $mesg = undef;
  101 +
  102 + diag('Binding anonymously');
  103 + $mesg = $ldap->bind;
  104 + ok( $mesg->code, $mesg->error_desc );
  105 +
  106 + $mesg = $ldap->unbind;
  107 + ok( !$mesg->code, $mesg->error_desc );
  108 +
  109 + diag('Binding with authentication');
  110 + $ldap = ldap_client();
  111 + $mesg = $ldap->bind( $ROOT_DN, password => $ROOT_PW );
  112 + ok( !$mesg->code,
  113 + 'should be able to bind with authentication ('
  114 + . $mesg->error_desc
  115 + . ')' );
  116 +
  117 + $mesg = $ldap->unbind;
  118 + ok( !$mesg->code, $mesg->error_desc );
  119 + },
  120 +);
47 t/15-search.t
... ... @@ -0,0 +1,47 @@
  1 +use Test::More tests => 9;
  2 +
  3 +use lib 't/lib';
  4 +use Helper qw(ldap_client test_requests);
  5 +
  6 +use Data::Dumper;
  7 +
  8 +my $DATA = 'examples/single-entry.ldif';
  9 +my $ROOT_PW = 'testpw';
  10 +
  11 +test_requests(
  12 + server_opts => {
  13 + data_file => $DATA,
  14 + root_pw => $ROOT_PW,
  15 + },
  16 + requests_sub => sub {
  17 + my $mesg = undef;
  18 +
  19 + my $ldap = ldap_client();
  20 + ok($ldap);
  21 +
  22 + $mesg = $ldap->bind;
  23 + ok( !$mesg->code, $mesg->error_desc );
  24 +
  25 + # no results for this one
  26 + $mesg = $ldap->search( base => 'DC=org', filter => '(dn=*)' );
  27 + ok( !$mesg->code, $mesg->error_desc );
  28 + my @entries = $mesg->entries;
  29 + is( scalar @entries, 0 );
  30 +
  31 + my $dn1 =
  32 + 'CN=Alexei Znamensky,OU=SnakeOil,OU=Extranet,DC=sa,DC=mynet,DC=net';
  33 + $mesg = $ldap->search(
  34 + base => 'DC=net',
  35 + filter => '(distinguishedname=' . $dn1 . ')'
  36 + );
  37 + ok( !$mesg->code, $mesg->error_desc );
  38 + @entries = $mesg->entries;
  39 + is( scalar @entries, 1 );
  40 + my $e = shift @entries;
  41 + is( $e->dn, $dn1 );
  42 + is( $e->get_value('sn'), 'Znamensky' );
  43 +
  44 + $mesg = $ldap->unbind;
  45 + ok( !$mesg->code, $mesg->error_desc );
  46 + }
  47 +);
131 t/lib/Helper.pm
... ... @@ -0,0 +1,131 @@
  1 +# common routines for testing Net::LDAP::SimpleServer
  2 +
  3 +use Exporter 'import';
  4 +our @EXPORT_OK = qw(ldap_client test_requests server_ok server_nok);
  5 +
  6 +use Carp;
  7 +use Proc::Fork;
  8 +use IO::Pipe;
  9 +
  10 +use Net::LDAP;
  11 +use Net::LDAP::SimpleServer;
  12 +
  13 +my $default_test_port = 30389;
  14 +my $default_start_delay = 5;
  15 +my $default_end_signal = 3;
  16 +
  17 +my $server_fixed_opts = {
  18 + log_file => '/tmp/ldapserver.log',
  19 + port => $default_test_port,
  20 + host => 'localhost',
  21 +};
  22 +
  23 +
  24 +##############################################################################
  25 +
  26 +my $alarm_wait = 5;
  27 +my $OK = 'OK';
  28 +my $NOK = 'NOK ';
  29 +
  30 +sub _eval_params {
  31 + my $p = shift;
  32 + my $result = undef;
  33 +
  34 + our $pipe = IO::Pipe->new;
  35 +
  36 + run_fork {
  37 + child {
  38 + $pipe->writer;
  39 +
  40 + sub quit {
  41 + print $pipe shift . "\n";
  42 + exit;
  43 + }
  44 +
  45 + alarm 0;
  46 + local $SIG{ALRM} = sub { quit($OK) };
  47 + alarm $alarm_wait;
  48 +
  49 + eval {
  50 + use Net::LDAP::SimpleServer;
  51 +
  52 + my $s = Net::LDAP::SimpleServer->new( $server_fixed_opts );
  53 + $s->run($p);
  54 + };
  55 + quit( $NOK . $@ );
  56 + }
  57 + };
  58 +
  59 + # parent code
  60 + $pipe->reader;
  61 +
  62 + $result = <$pipe>;
  63 + chomp $result;
  64 +
  65 + return $result;
  66 +}
  67 +
  68 +sub server_nok {
  69 + my ( $params, $test_name ) = @_;
  70 + my $res = _eval_params($params);
  71 +
  72 + #diag( 'res = ', $res);
  73 + if ( $res eq $OK ) {
  74 + diag( 'params = ', explain($params) );
  75 + fail($test_name);
  76 + return;
  77 + }
  78 + pass($test_name);
  79 +}
  80 +
  81 +sub server_ok {
  82 + my ( $params, $test_name ) = @_;
  83 + my $res = _eval_params($params);
  84 +
  85 + #diag( 'res = ', $res);
  86 + if ( $res eq $OK ) {
  87 + pass($test_name);
  88 + return;
  89 + }
  90 + diag( 'params = ', explain($params) );
  91 + fail( $test_name ? $test_name : $res );
  92 +}
  93 +
  94 +sub ldap_client {
  95 + return Net::LDAP->new( 'localhost', port => $default_test_port );
  96 +}
  97 +
  98 +sub test_requests {
  99 + my $opts = ref $_[0] eq 'HASH' ? $_[0] : { @_ };
  100 +
  101 + my $requests_sub = $opts->{requests_sub} || croak "Must pass 'requests_sub'";
  102 + my $server_opts = $opts->{server_opts} || croak "Must pass 'server_opts'";
  103 +
  104 + my $start_delay = $opts->{start_delay} || $default_start_delay;
  105 + my $end_signal = $opts->{end_signal} || $default_end_signal;
  106 +
  107 + run_fork {
  108 + parent {
  109 + my $child = shift;
  110 +
  111 + # give the server some time to start
  112 + sleep $start_delay;
  113 +
  114 + # run client
  115 + diag('Net::LDAP::SimpleServer Testing [Knive]');
  116 + $requests_sub->();
  117 +
  118 + kill $end_signal, $child;
  119 + }
  120 + child {
  121 + diag('Net::LDAP::SimpleServer Instantiating [Fork]');
  122 + my $s = Net::LDAP::SimpleServer->new( $server_fixed_opts );
  123 +
  124 + # run server
  125 + diag('Net::LDAP::SimpleServer Starting [Fork]');
  126 + $s->run( $server_opts );
  127 + diag('Net::LDAP::SimpleServer Server stopped [Fork]');
  128 + diag('There is no [Spoon]');
  129 + }
  130 + };
  131 +}

0 comments on commit 58f60bd

Please sign in to comment.
Something went wrong with that request. Please try again.