File Coverage

lib/Net/LDAP/SimpleServer.pm
Criterion Covered Total %
statement 72 82 87.8
branch 9 14 64.2
condition 2 5 40.0
subroutine 17 18 94.4
pod 4 4 100.0
total 104 123 84.5


line stmt bran cond sub pod time code
1             package Net::LDAP::SimpleServer;
2              
3 49     49   8406627 use strict;
  49         232  
  49         1562  
4 25     25   151 use warnings;
  25         47  
  25         1244  
5              
6             # ABSTRACT: Minimal-configuration, read-only LDAP server
7              
8             our $VERSION = '0.0.20'; # VERSION
9              
10 25     25   571 use 5.008;
  25         102  
11 25     25   159 use Carp;
  25         62  
  25         3943  
12              
13             our $personality = undef;
14              
15             sub import {
16 49     49   822 my $pkg = shift;
17 49   50     384 $personality = shift || 'Fork';
18              
19 25     25   621 eval "use base qw{Net::Server::$personality}"; ## no critic
  25         106  
  25         724  
  49         4530  
20 49 50       583133 croak $@ if $@;
21              
22 49         541 push @Net::LDAP::SimpleServer::ISA, qw(Net::Server);
23              
24             #use Data::Dumper;
25             #print STDERR Data::Dumper->Dump( [ \@Net::LDAP::SimpleServer::ISA ],
26             # ['ISA'] );
27 49         22056 return;
28             }
29              
30 25     25   179 use File::Basename;
  25         54  
  25         2015  
31 25     25   8673 use File::HomeDir;
  25         125092  
  25         1716  
32 25     25   209 use File::Spec;
  25         69  
  25         691  
33 25     25   131 use File::Path 2.08 qw{make_path};
  25         527  
  25         1755  
34 25     25   175 use Scalar::Util qw{reftype};
  25         82  
  25         1761  
35 25     25   8938 use Net::LDAP::SimpleServer::LDIFStore;
  25         109  
  25         1028  
36 25     25   10427 use Net::LDAP::SimpleServer::ProtocolHandler;
  25         101  
  25         1170  
37 25     25   201 use Net::LDAP::SimpleServer::Constant;
  25         67  
  25         17854  
38              
39             my $BASEDIR = File::Spec->catfile( home(), '.ldapsimple' );
40             my $DEFAULT_CONFIG_FILE = File::Spec->catfile( $BASEDIR, 'server.conf' );
41             my $DEFAULT_DATA_FILE = File::Spec->catfile( $BASEDIR, 'server.ldif' );
42             my $DEFAULT_LOG_FILE = File::Spec->catfile( $BASEDIR, 'server.log' );
43              
44             my @LDAP_PRIVATE_OPTIONS = qw/store input output/;
45             my @LDAP_PUBLIC_OPTIONS =
46             qw/data_file root_dn root_pw allow_anon user_passwords user_id_attr user_pw_attr user_filter/;
47              
48             make_path($BASEDIR);
49              
50             sub options {
51 37     37 1 61068856 my ( $self, $template ) = @_;
52 37         315 my $prop = $self->{server};
53              
54             ### setup options in the parent classes
55 37         1162 $self->SUPER::options($template);
56              
57             ### add a single value option
58 37         8350 for (@LDAP_PUBLIC_OPTIONS) {
59 296 100       1363 $prop->{$_} = undef unless exists $prop->{$_};
60 296         1423 $template->{$_} = \$prop->{$_};
61             }
62              
63             #use Data::Dumper;
64             #print STDERR Data::Dumper->Dump( [$self->{server}], ['server'] );
65 37         314 return;
66             }
67              
68             sub default_values {
69 31     31 1 3030 my $self = @_;
70              
71 31         195 my $v = {};
72 31         126 $v->{port} = 389;
73 31         349 $v->{log_file} = $DEFAULT_LOG_FILE;
74 31 50       665 $v->{conf_file} = $DEFAULT_CONFIG_FILE if -r $DEFAULT_CONFIG_FILE;
75             $v->{syslog_ident} =
76 31         345 'Net::LDAP::SimpleServer [' . $Net::LDAP::SimpleServer::VERSION . ']';
77              
78 31         554 $v->{allow_anon} = 1;
79 31         351 $v->{root_dn} = 'cn=root';
80 31 50       410 $v->{data_file} = $DEFAULT_DATA_FILE if -r $DEFAULT_DATA_FILE;
81 31         239 $v->{user_passwords} = USER_PW_NONE;
82 31         182 $v->{user_filter} = '(objectClass=person)';
83 31         429 $v->{user_id_attr} = 'uid';
84 31         170 $v->{user_pw_attr} = 'userPassword';
85              
86             #use Data::Dumper; print STDERR Dumper($v);
87 31         205 return $v;
88             }
89              
90             sub post_configure_hook {
91 17     17 1 28225 my $self = shift;
92 17         121 my $prop = $self->{server};
93              
94             # create server directory in home dir
95 17         2857 make_path($BASEDIR);
96              
97             #use Data::Dumper; print STDERR '# ' . Dumper( $prop );
98             croak q{Configuration has no "data_file" file!}
99 17 100       2743 unless $prop->{data_file};
100             croak qq{Cannot read data_file file (} . $prop->{data_file} . q{)}
101 13 100       959 unless -r $prop->{data_file};
102              
103             # data_file is not a "public" option in the server, it is created here
104             $prop->{store} =
105             Net::LDAP::SimpleServer::LDIFStore->new( $prop->{data_file} )
106 12   33     568 || croak q{Cannot create data store!};
107              
108 12         94 return;
109             }
110              
111             sub process_request {
112 0     0 1   my $self = shift;
113 0           my $prop = $self->{server};
114              
115 0           my $params = { map { ( $_ => $prop->{$_} ) } @LDAP_PUBLIC_OPTIONS };
  0            
116 0           for (@LDAP_PRIVATE_OPTIONS) {
117 0 0         $params->{$_} = $prop->{$_} if $prop->{$_};
118             }
119 0           $params->{sock} = $self->{server}->{client};
120 0           my $handler = Net::LDAP::SimpleServer::ProtocolHandler->new($params);
121              
122 0           until ( $handler->handle ) {
123              
124             # intentionally empty loop
125             }
126 0           return;
127             }
128              
129             1; # Magic true value required at end of module
130              
131             __END__