File Coverage

lib/Net/LDAP/SimpleServer.pm
Criterion Covered Total %
statement 65 75 86.6
branch 9 14 64.2
condition 2 5 40.0
subroutine 16 17 94.1
pod 4 4 100.0
total 96 115 83.4


line stmt bran cond sub pod time code
1             package Net::LDAP::SimpleServer;
2              
3 35     35   3627954 use strict;
  35         136  
  35         916  
4 18     18   93 use warnings;
  18         34  
  18         751  
5              
6             # ABSTRACT: Minimal-configuration, read-only LDAP server
7              
8             our $VERSION = '0.0.19'; # VERSION
9              
10 18     18   319 use 5.008;
  18         60  
11 18     18   80 use Carp;
  18         48  
  18         2691  
12              
13             our $personality = undef;
14              
15             sub import {
16 35     35   381 my $pkg = shift;
17 35   50     231 $personality = shift || 'Fork';
18              
19 18     18   114 eval "use base qw{Net::Server::$personality}"; ## no critic
  18         31  
  18         299  
  35         2268  
20 35 50       288461 croak $@ if $@;
21              
22 35         297 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 35         10765 return;
28             }
29              
30 18     18   113 use File::Basename;
  18         38  
  18         1517  
31 18     18   6083 use File::HomeDir;
  18         75560  
  18         974  
32 18     18   135 use File::Spec;
  18         35  
  18         423  
33 18     18   95 use File::Path 2.08 qw{make_path};
  18         309  
  18         1025  
34 18     18   115 use Scalar::Util qw{reftype};
  18         37  
  18         847  
35 18     18   4679 use Net::LDAP::SimpleServer::LDIFStore;
  18         58  
  18         839  
36 18     18   4906 use Net::LDAP::SimpleServer::ProtocolHandler;
  18         45  
  18         7682  
37              
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' );
41             my $DEFAULT_LOG_FILE = File::Spec->catfile( $BASEDIR, 'server.log' );
42              
43             my @LDAP_PRIVATE_OPTIONS = ( 'store', 'input', 'output' );
44             my @LDAP_PUBLIC_OPTIONS = ( 'data_file', 'root_dn', 'root_pw', 'allow_anon' );
45              
46             make_path($BASEDIR);
47              
48             sub options {
49 27     27 1 20911710 my ( $self, $template ) = @_;
50 27         144 my $prop = $self->{server};
51              
52             ### setup options in the parent classes
53 27         614 $self->SUPER::options($template);
54              
55             ### add a single value option
56 27         4317 for (@LDAP_PUBLIC_OPTIONS) {
57 108 100       597 $prop->{$_} = undef unless exists $prop->{$_};
58 108         468 $template->{$_} = \$prop->{$_};
59             }
60              
61             #use Data::Dumper;
62             #print STDERR Data::Dumper->Dump( [$self->{server}], ['server'] );
63 27         183 return;
64             }
65              
66             sub default_values {
67 21     21 1 1570 my $self = @_;
68              
69 21         157 my $v = {};
70 21         72 $v->{port} = 389;
71 21         157 $v->{log_file} = $DEFAULT_LOG_FILE;
72 21 50       604 $v->{conf_file} = $DEFAULT_CONFIG_FILE if -r $DEFAULT_CONFIG_FILE;
73             $v->{syslog_ident} =
74 21         1407 'Net::LDAP::SimpleServer [' . $Net::LDAP::SimpleServer::VERSION . ']';
75              
76 21         396 $v->{allow_anon} = 1;
77 21         127 $v->{root_dn} = 'cn=root';
78 21 50       311 $v->{data_file} = $DEFAULT_DATA_FILE if -r $DEFAULT_DATA_FILE;
79              
80             #use Data::Dumper; print STDERR Dumper($v);
81 21         120 return $v;
82             }
83              
84             sub post_configure_hook {
85 12     12 1 7687 my $self = shift;
86 12         86 my $prop = $self->{server};
87              
88             # create server directory in home dir
89 12         1744 make_path($BASEDIR);
90              
91             #use Data::Dumper; print STDERR '# ' . Dumper( $prop );
92             croak q{Configuration has no "data_file" file!}
93 12 100       1765 unless $prop->{data_file};
94             croak qq{Cannot read data_file file (} . $prop->{data_file} . q{)}
95 8 100       646 unless -r $prop->{data_file};
96              
97             # data_file is not a "public" option in the server, it is created here
98             $prop->{store} =
99             Net::LDAP::SimpleServer::LDIFStore->new( $prop->{data_file} )
100 7   33     281 || croak q{Cannot create data store!};
101              
102 7         49 return;
103             }
104              
105             sub process_request {
106 0     0 1   my $self = shift;
107 0           my $prop = $self->{server};
108              
109 0           my $params = { map { ( $_ => $prop->{$_} ) } @LDAP_PUBLIC_OPTIONS };
  0            
110 0           for (@LDAP_PRIVATE_OPTIONS) {
111 0 0         $params->{$_} = $prop->{$_} if $prop->{$_};
112             }
113 0           $params->{sock} = $self->{server}->{client};
114 0           my $handler = Net::LDAP::SimpleServer::ProtocolHandler->new($params);
115              
116 0           until ( $handler->handle ) {
117              
118             # intentionally empty loop
119             }
120 0           return;
121             }
122              
123             1; # Magic true value required at end of module
124              
125             __END__