line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Apache::Session::Store::LDAP; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
4
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
5
|
1
|
|
|
1
|
|
621
|
use Net::LDAP; |
|
1
|
|
|
|
|
194700
|
|
|
1
|
|
|
|
|
6
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
$VERSION = '0.5'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub new { |
10
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
11
|
0
|
|
|
|
|
|
return bless {}, $class; |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub insert { |
15
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
16
|
0
|
|
|
|
|
|
my $session = shift; |
17
|
0
|
|
|
|
|
|
$self->{args} = $session->{args}; |
18
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapObjectClass} ||= 'applicationProcess'; |
19
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeId} ||= 'cn'; |
20
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeContent} ||= 'description'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $msg = $self->ldap->add( |
23
|
|
|
|
|
|
|
$self->{args}->{ldapAttributeId} . "=" |
24
|
|
|
|
|
|
|
. $session->{data}->{_session_id} . "," |
25
|
|
|
|
|
|
|
. $self->{args}->{ldapConfBase}, |
26
|
|
|
|
|
|
|
attrs => [ |
27
|
|
|
|
|
|
|
objectClass => $self->{args}->{ldapObjectClass}, |
28
|
|
|
|
|
|
|
$self->{args}->{ldapAttributeId} => $session->{data}->{_session_id}, |
29
|
|
|
|
|
|
|
$self->{args}->{ldapAttributeContent} => $session->{serialized}, |
30
|
0
|
|
|
|
|
|
], |
31
|
|
|
|
|
|
|
); |
32
|
|
|
|
|
|
|
|
33
|
0
|
0
|
|
|
|
|
$self->ldap->unbind() && delete $self->{ldap}; |
34
|
0
|
0
|
|
|
|
|
$self->logError($msg) if ( $msg->code ); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub update { |
38
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
39
|
0
|
|
|
|
|
|
my $session = shift; |
40
|
0
|
|
|
|
|
|
$self->{args} = $session->{args}; |
41
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapObjectClass} ||= 'applicationProcess'; |
42
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeId} ||= 'cn'; |
43
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeContent} ||= 'description'; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
my $msg = $self->ldap->modify( |
46
|
|
|
|
|
|
|
$self->{args}->{ldapAttributeId} . "=" |
47
|
|
|
|
|
|
|
. $session->{data}->{_session_id} . "," |
48
|
|
|
|
|
|
|
. $self->{args}->{ldapConfBase}, |
49
|
|
|
|
|
|
|
replace => |
50
|
|
|
|
|
|
|
{ $self->{args}->{ldapAttributeContent} => $session->{serialized}, }, |
51
|
0
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
0
|
0
|
|
|
|
|
$self->ldap->unbind() && delete $self->{ldap}; |
54
|
0
|
0
|
|
|
|
|
$self->logError($msg) if ( $msg->code ); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub materialize { |
58
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
59
|
0
|
|
|
|
|
|
my $session = shift; |
60
|
0
|
|
|
|
|
|
$self->{args} = $session->{args}; |
61
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapObjectClass} ||= 'applicationProcess'; |
62
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeId} ||= 'cn'; |
63
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeContent} ||= 'description'; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $msg = $self->ldap->search( |
66
|
|
|
|
|
|
|
base => $self->{args}->{ldapAttributeId} . "=" |
67
|
|
|
|
|
|
|
. $session->{data}->{_session_id} . "," |
68
|
|
|
|
|
|
|
. $self->{args}->{ldapConfBase}, |
69
|
|
|
|
|
|
|
filter => '(objectClass=' . $self->{args}->{ldapObjectClass} . ')', |
70
|
|
|
|
|
|
|
scope => 'base', |
71
|
0
|
|
|
|
|
|
attrs => [ $self->{args}->{ldapAttributeContent} ], |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
|
74
|
0
|
0
|
|
|
|
|
$self->ldap->unbind() && delete $self->{ldap}; |
75
|
0
|
0
|
|
|
|
|
$self->logError($msg) if ( $msg->code ); |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
eval { |
78
|
|
|
|
|
|
|
$session->{serialized} = $msg->shift_entry() |
79
|
0
|
|
|
|
|
|
->get_value( $self->{args}->{ldapAttributeContent} ); |
80
|
|
|
|
|
|
|
}; |
81
|
|
|
|
|
|
|
|
82
|
0
|
0
|
|
|
|
|
if ( !defined $session->{serialized} ) { |
83
|
0
|
|
|
|
|
|
die "Object does not exist in data store"; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub remove { |
88
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
89
|
0
|
|
|
|
|
|
my $session = shift; |
90
|
0
|
|
|
|
|
|
$self->{args} = $session->{args}; |
91
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapObjectClass} ||= 'applicationProcess'; |
92
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeId} ||= 'cn'; |
93
|
0
|
|
0
|
|
|
|
$self->{args}->{ldapAttributeContent} ||= 'description'; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$self->ldap->delete( $self->{args}->{ldapAttributeId} . "=" |
96
|
|
|
|
|
|
|
. $session->{data}->{_session_id} . "," |
97
|
0
|
|
|
|
|
|
. $self->{args}->{ldapConfBase} ); |
98
|
|
|
|
|
|
|
|
99
|
0
|
0
|
|
|
|
|
$self->ldap->unbind() && delete $self->{ldap}; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub ldap { |
103
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
104
|
0
|
0
|
|
|
|
|
return $self->{ldap} if ( $self->{ldap} ); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# Parse servers configuration |
107
|
0
|
|
|
|
|
|
my $useTls = 0; |
108
|
0
|
|
|
|
|
|
my $tlsParam; |
109
|
0
|
|
|
|
|
|
my @servers = (); |
110
|
0
|
|
|
|
|
|
foreach my $server ( split /[\s,]+/, $self->{args}->{ldapServer} ) { |
111
|
0
|
0
|
|
|
|
|
if ( $server =~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) { |
112
|
0
|
|
|
|
|
|
$useTls = 1; |
113
|
0
|
|
|
|
|
|
$server = $1; |
114
|
0
|
|
0
|
|
|
|
$tlsParam = $2 || ""; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
else { |
117
|
0
|
|
|
|
|
|
$useTls = 0; |
118
|
|
|
|
|
|
|
} |
119
|
0
|
|
|
|
|
|
push @servers, $server; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# Compatibility |
123
|
0
|
|
0
|
|
|
|
my $caFile = $self->{args}->{ldapCAFile} || $self->{args}->{caFile}; |
124
|
0
|
|
0
|
|
|
|
my $caPath = $self->{args}->{ldapCAPath} || $self->{args}->{caPath}; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# Connect |
127
|
|
|
|
|
|
|
my $ldap = Net::LDAP->new( |
128
|
|
|
|
|
|
|
\@servers, |
129
|
|
|
|
|
|
|
onerror => undef, |
130
|
|
|
|
|
|
|
verify => $self->{args}->{ldapVerify} || "require", |
131
|
|
|
|
|
|
|
( $caFile ? ( cafile => $caFile ) : () ), |
132
|
|
|
|
|
|
|
( $caPath ? ( capath => $caPath ) : () ), |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
( |
135
|
|
|
|
|
|
|
$self->{args}->{ldapPort} |
136
|
|
|
|
|
|
|
? ( port => $self->{args}->{ldapPort} ) |
137
|
0
|
0
|
0
|
|
|
|
: () |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
138
|
|
|
|
|
|
|
), |
139
|
|
|
|
|
|
|
) or die( 'Unable to connect to ' . join( ' ', @servers ) . ': ' . $@ ); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Check SSL error for old Net::LDAP versions |
142
|
0
|
0
|
|
|
|
|
if ( $Net::LDAP::VERSION < '0.64' ) { |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# CentOS7 has a bug in which IO::Socket::SSL will return a broken |
145
|
|
|
|
|
|
|
# socket when certificate validation fails. Net::LDAP does not catch |
146
|
|
|
|
|
|
|
# it, and the process ends up crashing. |
147
|
|
|
|
|
|
|
# As a precaution, make sure the underlying socket is doing fine: |
148
|
0
|
0
|
0
|
|
|
|
if ( $ldap->socket->isa('IO::Socket::SSL') |
149
|
|
|
|
|
|
|
and $ldap->socket->errstr < 0 ) |
150
|
|
|
|
|
|
|
{ |
151
|
0
|
|
|
|
|
|
die( "SSL connection error: " . $ldap->socket->errstr ); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# Start TLS if needed |
156
|
0
|
0
|
|
|
|
|
if ($useTls) { |
157
|
0
|
|
|
|
|
|
my %h = split( /[&=]/, $tlsParam ); |
158
|
0
|
|
0
|
|
|
|
$h{verify} ||= ( $self->{args}->{ldapVerify} || "require" ); |
|
|
|
0
|
|
|
|
|
159
|
0
|
0
|
0
|
|
|
|
$h{cafile} ||= $caFile if ($caFile); |
160
|
0
|
0
|
0
|
|
|
|
$h{capath} ||= $caPath if ($caPath); |
161
|
0
|
|
|
|
|
|
my $start_tls = $ldap->start_tls(%h); |
162
|
0
|
0
|
|
|
|
|
if ( $start_tls->code ) { |
163
|
0
|
|
|
|
|
|
$self->logError($start_tls); |
164
|
0
|
|
|
|
|
|
return; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# Bind with credentials |
169
|
|
|
|
|
|
|
my $bind = $ldap->bind( $self->{args}->{ldapBindDN}, |
170
|
0
|
|
|
|
|
|
password => $self->{args}->{ldapBindPassword} ); |
171
|
0
|
0
|
|
|
|
|
if ( $bind->code ) { |
172
|
0
|
|
|
|
|
|
$self->logError($bind); |
173
|
0
|
|
|
|
|
|
return; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
0
|
|
|
|
|
|
$self->{ldap} = $ldap; |
177
|
0
|
|
|
|
|
|
return $ldap; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub logError { |
181
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
182
|
0
|
|
|
|
|
|
my $ldap_operation = shift; |
183
|
0
|
|
|
|
|
|
die "LDAP error " . $ldap_operation->code . ": " . $ldap_operation->error; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
1; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=pod |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head1 NAME |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Apache::Session::Store::LDAP - Use LDAP to store persistent objects |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head1 SYNOPSIS |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
use Apache::Session::Store::LDAP; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
my $store = new Apache::Session::Store::LDAP; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
$store->insert($ref); |
201
|
|
|
|
|
|
|
$store->update($ref); |
202
|
|
|
|
|
|
|
$store->materialize($ref); |
203
|
|
|
|
|
|
|
$store->remove($ref); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 DESCRIPTION |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
This module fulfills the storage interface of Apache::Session. The serialized |
208
|
|
|
|
|
|
|
objects are stored in an LDAP directory file using the Net::LDAP Perl module. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head1 OPTIONS |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
This module requires one argument in the usual Apache::Session style. The |
213
|
|
|
|
|
|
|
keys ldapServer, ldapBase, ldapBindDN, ldapBindPassword are required. The keys |
214
|
|
|
|
|
|
|
ldapPort, ldapObjectClass, ldapAttributeId, ldapAttributeContent are optional. |
215
|
|
|
|
|
|
|
Example: |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
tie %s, 'Apache::Session::LDAP', undef, |
218
|
|
|
|
|
|
|
{ |
219
|
|
|
|
|
|
|
ldapServer => 'localhost', |
220
|
|
|
|
|
|
|
ldapBase => 'dc=example,dc=com', |
221
|
|
|
|
|
|
|
ldapBindDN => 'cn=admin,dc=example,dc=com', |
222
|
|
|
|
|
|
|
ldapBindPassword => 'pass', |
223
|
|
|
|
|
|
|
ldapObjectClass => 'applicationProcess', |
224
|
|
|
|
|
|
|
ldapAttributeId => 'cn', |
225
|
|
|
|
|
|
|
ldapAttributeContent => 'description', |
226
|
|
|
|
|
|
|
}; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 AUTHOR |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Xavier Guimard, Eguimard@E |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Copyright (C) 2009, 2012 by Xavier Guimard |
235
|
|
|
|
|
|
|
Copyright (C) 2014, 2015 by Clement Oudot |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
238
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.10.0 or, |
239
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head1 SEE ALSO |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
L |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |