Skip to content

Commit

Permalink
Bug fix, small improvements
Browse files Browse the repository at this point in the history
- removed the Net::Server pre-requisite from dist.ini by mistake
- variable for default log file
- testing for config file existence is useless, since Net::Server checks and
  dies if the file is not readable
- fix documentation in lib/Net/LDAP/SimpleServer.pm
- tidy

Signed-off-by: Alexei Znamensky <russoz@cpan.org>
  • Loading branch information
russoz committed Jul 25, 2012
1 parent 58f60bd commit 24e7999
Show file tree
Hide file tree
Showing 4 changed files with 95 additions and 79 deletions.
4 changes: 4 additions & 0 deletions dist.ini
Expand Up @@ -7,3 +7,7 @@ copyright_year = 2012
[@Author::RUSSOZ]
version = gitnext

[Prereqs]
; keep the line below, Net::Server is loaded dynamically and Dist::Zilla
; will not automatically recognize it as a dependency
Net::Server = 2.003
72 changes: 39 additions & 33 deletions lib/Net/LDAP/SimpleServer.pm
Expand Up @@ -38,6 +38,7 @@ use Net::LDAP::SimpleServer::ProtocolHandler;
my $BASEDIR = File::Spec->catfile( home(), '.ldapsimple' );
my $DEFAULT_CONFIG_FILE = File::Spec->catfile( $BASEDIR, 'server.conf' );
my $DEFAULT_DATA_FILE = File::Spec->catfile( $BASEDIR, 'server.ldif' );
my $DEFAULT_LOG_FILE = File::Spec->catfile( $BASEDIR, 'server.log' );

my @LDAP_PRIVATE_OPTIONS = ( 'store', 'input', 'output' );
my @LDAP_PUBLIC_OPTIONS = ( 'data_file', 'root_dn', 'root_pw', 'allow_anon' );
Expand Down Expand Up @@ -67,7 +68,7 @@ sub default_values {

my $v = {};
$v->{port} = 389;
$v->{log_file} = File::Spec->catfile( $BASEDIR, 'server.log' );
$v->{log_file} = $DEFAULT_LOG_FILE;
$v->{conf_file} = $DEFAULT_CONFIG_FILE if -r $DEFAULT_CONFIG_FILE;
$v->{syslog_ident} =
'Net::LDAP::SimpleServer [' . $Net::LDAP::SimpleServer::VERSION . ']';
Expand All @@ -88,8 +89,6 @@ sub post_configure_hook {
make_path($BASEDIR);

#use Data::Dumper; print STDERR '# ' . Dumper( $prop );
croak q{Cannot read configuration file (} . $prop->{conf_file} . q{)}
if ( $prop->{conf_file} && !-r $prop->{conf_file} );
croak q{Configuration has no "data_file" file!}
unless $prop->{data_file};
croak qq{Cannot read data_file file (} . $prop->{data_file} . q{)}
Expand Down Expand Up @@ -150,9 +149,8 @@ __END__
# make it spin
$server->run();
The default configuration file is:
${HOME}/.ldapsimpleserver/config
# make it spin with options
$server->run({ allow_anon => 0 });
=head1 DESCRIPTION
Expand All @@ -169,56 +167,55 @@ notably writing into the directory tree.
The constructors will follow the rules defined by L<Net::Server>, but the most
useful are the two forms described below.
C<Net::LDAP::SimpleServer> will use the directory C<< ${HOME}/.ldapsimple >>
as a C<BASEDIR> for server files. If there exists a file:
BASEDIR/server.conf
it will be used as the default confguration file. Similarly, if there exists
a file:
BASEDIR/server.ldif
it will be used as the default data file for this server.
=method new()
Attempts to create a server by using the default configuration file,
C<< ${HOME}/.ldapsimpleserver/config >>.
Instantiates a server object. If the default configuration file is available,
the options in it will be used.
=method new( HASHREF )
Attempts to create a server by using the options specified in a hash
reference rather than reading them from a configuration file.
Instantiates a server object using the options specified in a hash
reference.
=method options()
As specified in L<Net::Server>, this method creates new options for the,
server, namely:
=over
data_file - the LDIF data file used by LDIFStore
root_dn - the administrator DN of the repository
=begin :list
root_pw - the password for root_dn
* data_file - the LDIF data file used by LDIFStore
* root_dn - the administrator DN of the repository
* root_pw - the password for root_dn
* allow_anon - whether to allow for anonymous binds
=back
=end :list
=method default_values()
As specified in L<Net::Server>, this method provides default values for a
number of options. In Net::LDAP::SimpleServer, this method is defined as:
sub default_values {
return {
host => '*',
port => 389,
proto => 'tcp',
root_dn => 'cn=root',
root_pw => 'ldappw',
syslog_ident => 'Net::LDAP::SimpleServer-'
. $Net::LDAP::SimpleServer::VERSION,
conf_file => $DEFAULT_CONFIG_FILE,
};
}
number of options.
Notice that we do set a default password for the C<< cn=root >> DN. This
allows for out-of-the-box testing, but make sure you change the password
when putting this to production use.
=method post_configure_hook()
Method specified by L<Net::Server> to validate the passed options
Method specified by L<Net::Server> to validate the parameters used in the
server instance.
=method process_request()
Expand All @@ -231,16 +228,25 @@ L<Net::LDAP::SimpleServer::ProtocolHandler>.
Net::LDAP::SimpleServer may use a configuration file to specify the
server settings. If no file is specified and options are not passed
in a hash, this module will look for a default configuration file named
C<< ${HOME}/.ldapsimpleserver/config >>.
C<< BASEDIR/server.conf >>.
data_file /path/to/a/ldif/file.ldif
#port 389
#root_dn cn=root
#root_pw somepassword
=cut
=head1 TODO
We plan to implement more options in Net::LDAP::SimpleServer. Some ideas are:
#objectclass_req (true|false)
#user_tree dc=some,dc=subtree,dc=com
#user_id_attr uid
#user_pw_attr password
Keeping in mind we do NOT want to implement a full blown LDAP server.
=cut
21 changes: 12 additions & 9 deletions lib/Net/LDAP/SimpleServer/ProtocolHandler.pm
Expand Up @@ -52,9 +52,9 @@ sub new {
croak 'Invalid root DN'
unless my $canon_dn = canonical_dn( $params->{root_dn} );

$self->{store} = $params->{store};
$self->{root_dn} = $canon_dn;
$self->{root_pw} = $params->{root_pw};
$self->{store} = $params->{store};
$self->{root_dn} = $canon_dn;
$self->{root_pw} = $params->{root_pw};
$self->{allow_anon} = $params->{allow_anon};
chomp( $self->{root_pw} );

Expand All @@ -71,15 +71,18 @@ sub unbind {
return _make_result(LDAP_SUCCESS);
}

sub bind { ## no critic
sub bind { ## no critic (ProhibitBuiltinHomonyms)
my ( $self, $request ) = @_;

#print STDERR '=' x 70 . "\n";
#print STDERR Dumper($self);
#print STDERR Dumper($request);
my $ok = _make_result(LDAP_SUCCESS);

if( not $request->{name} and exists $request->{authentication}->{simple} and $self->{allow_anon} ) {
if ( not $request->{name}
and exists $request->{authentication}->{simple}
and $self->{allow_anon} )
{
return $ok;
}

Expand Down Expand Up @@ -161,14 +164,14 @@ Creates a new handler for the LDAP protocol, using STORE as the backend
where the directory data is stored. The rest of the IOHANDLES are the same
as in the L<Net::LDAP::Server> module.
=method unbind()
Unbinds the connection to the server.
=method bind( REQUEST )
Handles a bind REQUEST from the LDAP client.
=method unbind()
Unbinds the connection to the server.
=method search( REQUEST )
Performs a search in the data store.
Expand Down
77 changes: 40 additions & 37 deletions t/lib/Helper.pm
Expand Up @@ -10,17 +10,16 @@ use IO::Pipe;
use Net::LDAP;
use Net::LDAP::SimpleServer;

my $default_test_port = 30389;
my $default_test_port = 30389;
my $default_start_delay = 5;
my $default_end_signal = 3;
my $default_end_signal = 3;

my $server_fixed_opts = {
log_file => '/tmp/ldapserver.log',
port => $default_test_port,
host => 'localhost',
my $server_fixed_opts = {
log_file => '/tmp/ldapserver.log',
port => $default_test_port,
host => 'localhost',
};


##############################################################################

my $alarm_wait = 5;
Expand All @@ -46,10 +45,11 @@ sub _eval_params {
local $SIG{ALRM} = sub { quit($OK) };
alarm $alarm_wait;

diag( "Starting server on port: " . $default_test_port );
eval {
use Net::LDAP::SimpleServer;

my $s = Net::LDAP::SimpleServer->new( $server_fixed_opts );
my $s = Net::LDAP::SimpleServer->new($server_fixed_opts);
$s->run($p);
};
quit( $NOK . $@ );
Expand Down Expand Up @@ -96,36 +96,39 @@ sub ldap_client {
}

sub test_requests {
my $opts = ref $_[0] eq 'HASH' ? $_[0] : { @_ };
my $opts = ref $_[0] eq 'HASH' ? $_[0] : {@_};

my $requests_sub = $opts->{requests_sub} || croak "Must pass 'requests_sub'";
my $server_opts = $opts->{server_opts} || croak "Must pass 'server_opts'";
my $requests_sub = $opts->{requests_sub}
|| croak "Must pass 'requests_sub'";
my $server_opts = $opts->{server_opts} || croak "Must pass 'server_opts'";

my $start_delay = $opts->{start_delay} || $default_start_delay;
my $end_signal = $opts->{end_signal} || $default_end_signal;

run_fork {
parent {
my $child = shift;

# give the server some time to start
sleep $start_delay;

# run client
diag('Net::LDAP::SimpleServer Testing [Knive]');
$requests_sub->();

kill $end_signal, $child;
}
child {
diag('Net::LDAP::SimpleServer Instantiating [Fork]');
my $s = Net::LDAP::SimpleServer->new( $server_fixed_opts );

# run server
diag('Net::LDAP::SimpleServer Starting [Fork]');
$s->run( $server_opts );
diag('Net::LDAP::SimpleServer Server stopped [Fork]');
diag('There is no [Spoon]');
}
};
my $end_signal = $opts->{end_signal} || $default_end_signal;

run_fork {
parent {
my $child = shift;

# give the server some time to start
sleep $start_delay;

# run client
diag('Net::LDAP::SimpleServer Testing [Knive]');
$requests_sub->();

kill $end_signal, $child;
}
child {
diag('Net::LDAP::SimpleServer Instantiating [Fork]');
my $s = Net::LDAP::SimpleServer->new($server_fixed_opts);

# run server
diag( 'Net::LDAP::SimpleServer Starting :'
. $default_test_port
. ' [Fork]' );
$s->run($server_opts);
diag('Net::LDAP::SimpleServer Server stopped [Fork]');
diag('There is no [Spoon]');
}
};
}

0 comments on commit 24e7999

Please sign in to comment.