line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#=============================================================================== |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Apache::AuthCookieLDAP |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# An AuthCookie module backed by a LDAP database. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Based on Apache::AuthCookieDBI by Jacob Davies |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Author: Bjorn Ardo |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
12
|
|
|
|
|
|
|
# modify it under the terms of the GNU Lesser General Public |
13
|
|
|
|
|
|
|
# License as published by the Free Software Foundation; either |
14
|
|
|
|
|
|
|
# version 2.1 of the License, or (at your option) any later version. |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# This library is distributed in the hope that it will be useful, |
17
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
18
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19
|
|
|
|
|
|
|
# Lesser General Public License for more details. |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# You should have received a copy of the GNU Lesser General Public |
22
|
|
|
|
|
|
|
# License along with this library; if not, write to the Free Software |
23
|
|
|
|
|
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
24
|
|
|
|
|
|
|
# |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
|
|
|
#=============================================================================== |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
package Apache::AuthCookieLDAP; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
1
|
|
889
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
41
|
|
31
|
1
|
|
|
1
|
|
25
|
use 5.004; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
48
|
|
32
|
1
|
|
|
1
|
|
6
|
use vars qw( $VERSION ); |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
105
|
|
33
|
|
|
|
|
|
|
( $VERSION ) = '$Revision: 0.03 $' =~ /([\d.]+)/; |
34
|
|
|
|
|
|
|
|
35
|
1
|
|
|
1
|
|
1930
|
use Apache::AuthCookie; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
use vars qw( @ISA ); |
37
|
|
|
|
|
|
|
@ISA = qw( Apache::AuthCookie ); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
use Apache; |
40
|
|
|
|
|
|
|
use Apache::Constants; |
41
|
|
|
|
|
|
|
use Apache::File; |
42
|
|
|
|
|
|
|
use Digest::MD5 qw( md5_hex ); |
43
|
|
|
|
|
|
|
use Date::Calc qw( Today_and_Now Add_Delta_DHMS ); |
44
|
|
|
|
|
|
|
# Also uses Crypt::CBC if you're using encrypted cookies. |
45
|
|
|
|
|
|
|
use Net::LDAP qw(LDAP_SUCCESS); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
#=============================================================================== |
48
|
|
|
|
|
|
|
# F U N C T I O N D E C L A R A T I O N S |
49
|
|
|
|
|
|
|
#=============================================================================== |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub _log_not_set($$); |
52
|
|
|
|
|
|
|
sub _dir_config_var($$); |
53
|
|
|
|
|
|
|
sub _dbi_config_vars($); |
54
|
|
|
|
|
|
|
sub _now_year_month_day_hour_minute_second(); |
55
|
|
|
|
|
|
|
sub _percent_encode($); |
56
|
|
|
|
|
|
|
sub _percent_decode($); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub authen_cred($$\@); |
59
|
|
|
|
|
|
|
sub authen_ses_key($$$); |
60
|
|
|
|
|
|
|
sub group($$$); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
#=============================================================================== |
63
|
|
|
|
|
|
|
# P A C K A G E G L O B A L S |
64
|
|
|
|
|
|
|
#=============================================================================== |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
use vars qw( %CIPHERS ); |
67
|
|
|
|
|
|
|
# Stores Cipher::CBC objects in $CIPHERS{ idea:AuthName }, |
68
|
|
|
|
|
|
|
# $CIPHERS{ des:AuthName } etc. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
use vars qw( %SECRET_KEYS ); |
71
|
|
|
|
|
|
|
# Stores secret keys for MD5 checksums and encryption for each auth realm in |
72
|
|
|
|
|
|
|
# $SECRET_KEYS{ AuthName }. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
#=============================================================================== |
75
|
|
|
|
|
|
|
# S E R V E R S T A R T I N I T I A L I Z A T I O N |
76
|
|
|
|
|
|
|
#=============================================================================== |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
BEGIN { |
79
|
|
|
|
|
|
|
my @keyfile_vars = grep { |
80
|
|
|
|
|
|
|
$_ =~ /LDAP_SecretKeyFile$/ |
81
|
|
|
|
|
|
|
} keys %{ Apache->server->dir_config() }; |
82
|
|
|
|
|
|
|
foreach my $keyfile_var ( @keyfile_vars ) { |
83
|
|
|
|
|
|
|
my $keyfile = Apache->server->dir_config( $keyfile_var ); |
84
|
|
|
|
|
|
|
my $auth_name = $keyfile_var; |
85
|
|
|
|
|
|
|
$auth_name =~ s/LDAP_SecretKeyFile$//; |
86
|
|
|
|
|
|
|
unless ( open( KEY, "<$keyfile" ) ) { |
87
|
|
|
|
|
|
|
Apache::log_error( "Could not open keyfile for $auth_name in file $keyfile" ); |
88
|
|
|
|
|
|
|
} else { |
89
|
|
|
|
|
|
|
$SECRET_KEYS{ $auth_name } = ; |
90
|
|
|
|
|
|
|
close KEY; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
#=============================================================================== |
96
|
|
|
|
|
|
|
# P E R L D O C |
97
|
|
|
|
|
|
|
#=============================================================================== |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 NAME |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Apache::AuthCookieLDAP - An AuthCookie module backed by a LDAP database. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 VERSION |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
$Revision: 0.02 $ |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 SYNOPSIS |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Not correct!!! |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# In httpd.conf or .htaccess |
113
|
|
|
|
|
|
|
PerlModule Apache::AuthCookieLDAP |
114
|
|
|
|
|
|
|
PerlSetVar WhatEverPath / |
115
|
|
|
|
|
|
|
PerlSetVar WhatEverLoginScript /login.pl |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# Optional, to share tickets between servers. |
118
|
|
|
|
|
|
|
PerlSetVar WhatEverDomain .domain.com |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# These must be set |
121
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_DN "o=foo.com" |
122
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_SecretKeyFile /etc/httpd/acme.com.key |
123
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_User uid |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# These are optional, the module sets sensible defaults. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_filter F=on |
129
|
|
|
|
|
|
|
PerlSetVar WhatEverDBI_GroupsTable "groups" |
130
|
|
|
|
|
|
|
PerlSetVar WhatEverDBI_GroupField "grp" |
131
|
|
|
|
|
|
|
PerlSetVar WhatEverDBI_GroupUserField "user" |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_host ldap.bank.com |
134
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_EncryptionType "none" |
135
|
|
|
|
|
|
|
PerlSetVar WhatEverLDAP_SessionLifetime 00-24-00-00 |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Protected by AuthCookieLDAP. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
AuthType Apache::AuthCookieLDAP |
140
|
|
|
|
|
|
|
AuthName WhatEver |
141
|
|
|
|
|
|
|
PerlAuthenHandler Apache::AuthCookieLDAP->authenticate |
142
|
|
|
|
|
|
|
PerlAuthzHandler Apache::AuthCookieLDAP->authorize |
143
|
|
|
|
|
|
|
require valid-user |
144
|
|
|
|
|
|
|
# or you can require users: |
145
|
|
|
|
|
|
|
require user jacob |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# You can optionally require groups. |
148
|
|
|
|
|
|
|
require group system |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# Login location. *** DEBUG *** I still think this is screwy |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
AuthType Apache::AuthCookieLDAP |
154
|
|
|
|
|
|
|
AuthName WhatEver |
155
|
|
|
|
|
|
|
SetHandler perl-script |
156
|
|
|
|
|
|
|
PerlHandler Apache::AuthCookieLDAP->login |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head1 DESCRIPTION |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
This module is an authentication handler that uses the basic mechanism provided |
162
|
|
|
|
|
|
|
by Apache::AuthCookie with a LDAP database for ticket-based protection. It |
163
|
|
|
|
|
|
|
is based on two tokens being provided, a username and password, which can |
164
|
|
|
|
|
|
|
be any strings (there are no illegal characters for either). The username is |
165
|
|
|
|
|
|
|
used to set the remote user as if Basic Authentication was used. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
On an attempt to access a protected location without a valid cookie being |
168
|
|
|
|
|
|
|
provided, the module prints an HTML login form (produced by a CGI or any |
169
|
|
|
|
|
|
|
other handler; this can be a static file if you want to always send people |
170
|
|
|
|
|
|
|
to the same entry page when they log in). This login form has fields for |
171
|
|
|
|
|
|
|
username and password. On submitting it, the username and password are looked |
172
|
|
|
|
|
|
|
up in the LDAP database. If this succeeds, the user is issued |
173
|
|
|
|
|
|
|
a ticket. This ticket contains the username, an issue time, an expire time, |
174
|
|
|
|
|
|
|
and an MD5 checksum of those and a secret key for the server. It can |
175
|
|
|
|
|
|
|
optionally be encrypted before returning it to the client in the cookie; |
176
|
|
|
|
|
|
|
encryption is only useful for preventing the client from seeing the expire |
177
|
|
|
|
|
|
|
time. If you wish to protect passwords in transport, use an SSL-encrypted |
178
|
|
|
|
|
|
|
connection. The ticket is given in a cookie that the browser stores. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
After a login the user is redirected to the location they originally wished |
181
|
|
|
|
|
|
|
to view (or to a fixed page if the login "script" was really a static file). |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
On this access and any subsequent attempt to access a protected document, the |
184
|
|
|
|
|
|
|
browser returns the ticket to the server. The server unencrypts it if |
185
|
|
|
|
|
|
|
encrypted tickets are enabled, then extracts the username, issue time, expire |
186
|
|
|
|
|
|
|
time and checksum. A new checksum is calculated of the username, issue time, |
187
|
|
|
|
|
|
|
expire time and the secret key again; if it agrees with the checksum that |
188
|
|
|
|
|
|
|
the client supplied, we know that the data has not been tampered with. We |
189
|
|
|
|
|
|
|
next check that the expire time has not passed. If not, the ticket is still |
190
|
|
|
|
|
|
|
good, so we set the username. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Authorization checks then check that any "require valid-user" or "require |
193
|
|
|
|
|
|
|
user jacob" settings are passed. If all these |
194
|
|
|
|
|
|
|
checks pass, the document requested is displayed. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
If a ticket has expired or is otherwise invalid it is cleared in the browser |
197
|
|
|
|
|
|
|
and the login form is shown again. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=cut |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#=============================================================================== |
202
|
|
|
|
|
|
|
# P R I V A T E F U N C T I O N S |
203
|
|
|
|
|
|
|
#=============================================================================== |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
206
|
|
|
|
|
|
|
# _log_not_set -- Log that a particular authentication variable was not set. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub _log_not_set($$) |
209
|
|
|
|
|
|
|
{ |
210
|
|
|
|
|
|
|
my( $r, $variable ) = @_; |
211
|
|
|
|
|
|
|
my $auth_name = $r->auth_name; |
212
|
|
|
|
|
|
|
$r->log_error( "Apache::AuthCookieLDAP: $variable not set for auth realm |
213
|
|
|
|
|
|
|
$auth_name", $r->uri ); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
217
|
|
|
|
|
|
|
# _dir_config_var -- Get a particular authentication variable. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub _dir_config_var($$) |
220
|
|
|
|
|
|
|
{ |
221
|
|
|
|
|
|
|
my( $r, $variable ) = @_; |
222
|
|
|
|
|
|
|
my $auth_name = $r->auth_name; |
223
|
|
|
|
|
|
|
return $r->dir_config( "$auth_name$variable" ); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
227
|
|
|
|
|
|
|
# _dbi_config_vars -- Gets the config variables from the dir_config and logs |
228
|
|
|
|
|
|
|
# errors if required fields were not set, returns undef if any of the fields |
229
|
|
|
|
|
|
|
# had errors or a hash of the values if they were all OK. Takes a request |
230
|
|
|
|
|
|
|
# object. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub _dbi_config_vars($) |
233
|
|
|
|
|
|
|
{ |
234
|
|
|
|
|
|
|
my( $r ) = @_; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
my %c; # config variables hash |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head1 APACHE CONFIGURATION DIRECTIVES |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
All configuration directives for this module are passed in PerlSetVars. These |
242
|
|
|
|
|
|
|
PerlSetVars must begin with the AuthName that you are describing, so if your |
243
|
|
|
|
|
|
|
AuthName is PrivateBankingSystem they will look like: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
PerlSetVar PrivateBankingSystemLDAP_DN "o=bank.com" |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
See also L for the directives required for any kind |
248
|
|
|
|
|
|
|
of Apache::AuthCookie-based authentication system. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
In the following descriptions, replace "WhatEver" with your particular |
251
|
|
|
|
|
|
|
AuthName. The available configuration directives are as follows: |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=over 4 |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item C |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Specifies the BaseDN for LDAP for the database you wish to connect to retrieve |
258
|
|
|
|
|
|
|
user information. This is required and has no default value. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=cut |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
unless ( $c{ LDAP_DN } = _dir_config_var $r, 'LDAP_DN' ) { |
263
|
|
|
|
|
|
|
_log_not_set $r, 'LDAP_DN'; |
264
|
|
|
|
|
|
|
return undef; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item C |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Specifies the user id in the database you wish to connect to retrieve |
270
|
|
|
|
|
|
|
user information. This is required and has no default value. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=cut |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
unless ( $c{ LDAP_user } = _dir_config_var $r, 'LDAP_user' ) { |
275
|
|
|
|
|
|
|
_log_not_set $r, 'LDAP_user'; |
276
|
|
|
|
|
|
|
return undef; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=item C |
280
|
|
|
|
|
|
|
The host to connect to. This is not required and defaults to localhost. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
$c{ LDAP_host } = _dir_config_var( $r, 'LDAP_host' ) |
286
|
|
|
|
|
|
|
|| "localhost"; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=item C |
292
|
|
|
|
|
|
|
An extra filter for the search for the user. Is not required |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=cut |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$c{ LDAP_filter } = _dir_config_var( $r, 'LDAP_filter') || ""; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item C |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
The file that contains the secret key (on the first line of the file). This |
304
|
|
|
|
|
|
|
is required and has no default value. This key should be owned and only |
305
|
|
|
|
|
|
|
readable by root. It is read at server startup time. |
306
|
|
|
|
|
|
|
The key should be long and fairly random. If you want, you |
307
|
|
|
|
|
|
|
can change it and restart the server, (maybe daily), which will invalidate |
308
|
|
|
|
|
|
|
all prior-issued tickets. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
unless ( |
313
|
|
|
|
|
|
|
$c{ LDAP_secretkeyfile } = _dir_config_var $r, 'LDAP_SecretKeyFile' |
314
|
|
|
|
|
|
|
) { |
315
|
|
|
|
|
|
|
_log_not_set $r, 'LDAP_SecretKeyFile'; |
316
|
|
|
|
|
|
|
return undef; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=item C |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
What kind of encryption to use to prevent the user from looking at the fields |
322
|
|
|
|
|
|
|
in the ticket we give them. This is almost completely useless, so don't |
323
|
|
|
|
|
|
|
switch it on unless you really know you need it. It does not provide any |
324
|
|
|
|
|
|
|
protection of the password in transport; use SSL for that. It can be 'none', |
325
|
|
|
|
|
|
|
'des', 'idea', 'blowfish', or 'blowfish_pp'. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
This is not required and defaults to 'none'. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
$c{ LDAP_encryptiontype } = _dir_config_var( $r, 'LDAP_EncryptionType' ) |
332
|
|
|
|
|
|
|
|| 'none'; |
333
|
|
|
|
|
|
|
# If we used encryption we need to pull in Crypt::CBC. |
334
|
|
|
|
|
|
|
if ( $c{ LDAP_encryptiontype } ne 'none' ) { |
335
|
|
|
|
|
|
|
require Crypt::CBC; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=item C |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
How long tickets are good for after being issued. Note that presently |
341
|
|
|
|
|
|
|
Apache::AuthCookie does not set a client-side expire time, which means that |
342
|
|
|
|
|
|
|
most clients will only keep the cookie until the user quits the browser. |
343
|
|
|
|
|
|
|
However, if you wish to force people to log in again sooner than that, set |
344
|
|
|
|
|
|
|
this value. This can be 'forever' or a life time specified as: |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
DD-hh-mm-ss -- Days, hours, minute and seconds to live. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
This is not required and defaults to '00-24-00-00' or 24 hours. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
$c{ LDAP_sessionlifetime } |
353
|
|
|
|
|
|
|
= _dir_config_var( $r, 'LDAP_SessionLifetime' ) || '00-24-00-00'; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
## This is for some leftover DBI code: |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=item C |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Specifies the DSN for DBI for the database you wish to connect to retrieve |
365
|
|
|
|
|
|
|
user information. This is required and has no default value. |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=cut |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
unless ( $c{ DBI_DSN } = _dir_config_var $r, 'DBI_DSN' ) { |
370
|
|
|
|
|
|
|
_log_not_set $r, 'DBI_DSN'; |
371
|
|
|
|
|
|
|
return undef; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=item C |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
The user to log into the database as. This is not required and |
377
|
|
|
|
|
|
|
defaults to undef. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=cut |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
$c{ DBI_user } = _dir_config_var( $r, 'DBI_User') |
382
|
|
|
|
|
|
|
|| undef; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=item C |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
The password to use to access the database. This is not required |
387
|
|
|
|
|
|
|
and defaults to undef. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=cut |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
$c{ DBI_password } = _dir_config_var( $r, 'DBI_Password' ) |
392
|
|
|
|
|
|
|
|| undef; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item C |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
The table that has the user / group information. This is not required and |
399
|
|
|
|
|
|
|
defaults to 'groups'. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
$c{ DBI_groupstable } = _dir_config_var( $r, 'DBI_GroupsTable') |
404
|
|
|
|
|
|
|
|| 'groups'; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item C |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
The field in the above table that has the group name. This is not required |
409
|
|
|
|
|
|
|
and defaults to 'grp' (to prevent conflicts with the SQL reserved word |
410
|
|
|
|
|
|
|
'group'). |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=cut |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
$c{ DBI_groupfield } = _dir_config_var( $r, 'DBI_GroupField') |
415
|
|
|
|
|
|
|
|| 'grp'; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=item C |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
The field in the above table that has the user name. This is not required |
420
|
|
|
|
|
|
|
and defaults to 'user'. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=cut |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
$c{ DBI_groupuserfield } = _dir_config_var( $r, 'DBI_GroupUserField' ) |
425
|
|
|
|
|
|
|
|| 'user'; |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
return %c; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
435
|
|
|
|
|
|
|
# _now_year_month_day_hour_minute_second -- Return a string with the time in |
436
|
|
|
|
|
|
|
# this order separated by dashes. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
sub _now_year_month_day_hour_minute_second() |
439
|
|
|
|
|
|
|
{ |
440
|
|
|
|
|
|
|
return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
444
|
|
|
|
|
|
|
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics |
445
|
|
|
|
|
|
|
# in the supplied string. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub _percent_encode($) |
448
|
|
|
|
|
|
|
{ |
449
|
|
|
|
|
|
|
my( $str ) = @_; |
450
|
|
|
|
|
|
|
$str =~ s/([^\w])/ uc sprintf '%%%02x', ord $1 /eg; |
451
|
|
|
|
|
|
|
return $str; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
455
|
|
|
|
|
|
|
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in |
456
|
|
|
|
|
|
|
# the supplied string. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub _percent_decode($) |
459
|
|
|
|
|
|
|
{ |
460
|
|
|
|
|
|
|
my( $str ) = @_; |
461
|
|
|
|
|
|
|
$str =~ s/%([0-9a-fA-F]{2})/ pack( "c",hex( $1 ) ) /ge; |
462
|
|
|
|
|
|
|
return $str; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
#=============================================================================== |
466
|
|
|
|
|
|
|
# P U B L I C F U N C T I O N S |
467
|
|
|
|
|
|
|
#=============================================================================== |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
470
|
|
|
|
|
|
|
# Take the credentials for a user and check that they match; if so, return |
471
|
|
|
|
|
|
|
# a new session key for this user that can be stored in the cookie. |
472
|
|
|
|
|
|
|
# If there is a problem, return a bogus session key. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
sub authen_cred($$\@) |
475
|
|
|
|
|
|
|
{ |
476
|
|
|
|
|
|
|
my( $self, $r, @credentials ) = @_; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
my $auth_name = $r->auth_name; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# Username goes in credential_0 |
481
|
|
|
|
|
|
|
my $user = $credentials[ 0 ]; |
482
|
|
|
|
|
|
|
unless ( $user =~ /^.+$/ ) { |
483
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: no username supplied for auth realm $auth_name", $r->uri ); |
484
|
|
|
|
|
|
|
return 'bad'; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
# Password goes in credential_1 |
487
|
|
|
|
|
|
|
my $password = $credentials[ 1 ]; |
488
|
|
|
|
|
|
|
unless ( $password =~ /^.+$/ ) { |
489
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: no password supplied for auth realm $auth_name", $r->uri ); |
490
|
|
|
|
|
|
|
return 'bad'; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# get the configuration information. |
494
|
|
|
|
|
|
|
my %c = _dbi_config_vars $r; |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# Connect to the host |
500
|
|
|
|
|
|
|
my $con; |
501
|
|
|
|
|
|
|
unless ($con = Net::LDAP->new($c{LDAP_host})) |
502
|
|
|
|
|
|
|
{ |
503
|
|
|
|
|
|
|
$r->log_reason("LDAP Connection Failed", $r->uri); |
504
|
|
|
|
|
|
|
return 'bad'; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
# Bind annonymously |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
my $mess = $con->bind(); |
511
|
|
|
|
|
|
|
unless ($mess->code == LDAP_SUCCESS) { |
512
|
|
|
|
|
|
|
$r->log_reason("LDAP Bind Failed", $r->uri); |
513
|
|
|
|
|
|
|
return 'bad'; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# Search for the user |
518
|
|
|
|
|
|
|
my $filter = "($c{LDAP_user}=$user)"; |
519
|
|
|
|
|
|
|
if($c{LDAP_filter} ne "") |
520
|
|
|
|
|
|
|
{ |
521
|
|
|
|
|
|
|
$filter = "(& $filter ($c{LDAP_filter}))"; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
$mess = $con->search(base => $c{LDAP_DN}, filter => $filter); |
524
|
|
|
|
|
|
|
unless ($mess->code == LDAP_SUCCESS) { |
525
|
|
|
|
|
|
|
$r->log_reason("LDAP Search Failed", $r->uri); |
526
|
|
|
|
|
|
|
return 'bad'; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
# Does the user exsists |
531
|
|
|
|
|
|
|
unless ($mess->count) { |
532
|
|
|
|
|
|
|
$r->log_reason("User: $user does not excist", $r->uri); |
533
|
|
|
|
|
|
|
return 'bad'; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# Take the first user |
537
|
|
|
|
|
|
|
my $entry = $mess->first_entry; |
538
|
|
|
|
|
|
|
my $dn = $entry->dn; |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# Bind as the user we're authenticating |
541
|
|
|
|
|
|
|
$mess = $con->bind($dn, password => $password); |
542
|
|
|
|
|
|
|
unless ($mess->code == LDAP_SUCCESS) { |
543
|
|
|
|
|
|
|
$r->log_reason("User $user har wrong password", $r->uri); |
544
|
|
|
|
|
|
|
return 'bad'; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
$con->unbind; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# Create the expire time for the ticket. |
551
|
|
|
|
|
|
|
my $expire_time; |
552
|
|
|
|
|
|
|
# expire time in a zillion years if it's forever. |
553
|
|
|
|
|
|
|
if ( lc $c{ LDAP_sessionlifetime } eq 'forever' ) { |
554
|
|
|
|
|
|
|
$expire_time = '9999-01-01-01-01-01'; |
555
|
|
|
|
|
|
|
} else { |
556
|
|
|
|
|
|
|
my( $deltaday, $deltahour, $deltaminute, $deltasecond ) |
557
|
|
|
|
|
|
|
= split /-/, $c{ LDAP_sessionlifetime }; |
558
|
|
|
|
|
|
|
# Figure out the expire time. |
559
|
|
|
|
|
|
|
$expire_time = sprintf( |
560
|
|
|
|
|
|
|
'%04d-%02d-%02d-%02d-%02d-%02d', |
561
|
|
|
|
|
|
|
Add_Delta_DHMS( Today_and_Now, |
562
|
|
|
|
|
|
|
$deltaday, $deltahour, |
563
|
|
|
|
|
|
|
$deltaminute, $deltasecond ) |
564
|
|
|
|
|
|
|
); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# Now we need to %-encode non-alphanumberics in the username so we |
568
|
|
|
|
|
|
|
# can stick it in the cookie safely. *** DEBUG *** check this |
569
|
|
|
|
|
|
|
my $enc_user = _percent_encode $user; |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
# OK, now we stick the username and the current time and the expire |
572
|
|
|
|
|
|
|
# time together to make the public part of the session key: |
573
|
|
|
|
|
|
|
my $current_time = _now_year_month_day_hour_minute_second; |
574
|
|
|
|
|
|
|
my $public_part = "$enc_user:$current_time:$expire_time"; |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# Now we calculate the hash of this and the secret key and then |
577
|
|
|
|
|
|
|
# calculate the hash of *that* and the secret key again. |
578
|
|
|
|
|
|
|
my $secret_key = $SECRET_KEYS{ $auth_name }; |
579
|
|
|
|
|
|
|
unless ( defined $secret_key ) { |
580
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: didn't have the secret key for auth realm $auth_name", $r->uri ); |
581
|
|
|
|
|
|
|
return 'bad'; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
my $hash = md5_hex( join ':', $secret_key, md5_hex( |
584
|
|
|
|
|
|
|
join ':', $public_part, $secret_key |
585
|
|
|
|
|
|
|
) ); |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Now we add this hash to the end of the public part. |
588
|
|
|
|
|
|
|
my $session_key = "$public_part:$hash"; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# Now we encrypt this and return it. |
591
|
|
|
|
|
|
|
my $encrypted_session_key; |
592
|
|
|
|
|
|
|
if ( $c{ LDAP_encryptiontype } eq 'none' ) { |
593
|
|
|
|
|
|
|
$encrypted_session_key = $session_key; |
594
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'des' ) { |
595
|
|
|
|
|
|
|
$CIPHERS{ "des:$auth_name" } |
596
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'DES' ); |
597
|
|
|
|
|
|
|
$encrypted_session_key = $CIPHERS{ |
598
|
|
|
|
|
|
|
"des:$auth_name" |
599
|
|
|
|
|
|
|
}->encrypt_hex( $session_key ); |
600
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'idea' ) { |
601
|
|
|
|
|
|
|
$CIPHERS{ "idea:$auth_name" } |
602
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'IDEA' ); |
603
|
|
|
|
|
|
|
$encrypted_session_key = $CIPHERS{ |
604
|
|
|
|
|
|
|
"idea:$auth_name" |
605
|
|
|
|
|
|
|
}->encrypt_hex( $session_key ); |
606
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'blowfish' ) { |
607
|
|
|
|
|
|
|
$CIPHERS{ "blowfish:$auth_name" } |
608
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'Blowfish' ); |
609
|
|
|
|
|
|
|
$encrypted_session_key = $CIPHERS{ |
610
|
|
|
|
|
|
|
"blowfish:$auth_name" |
611
|
|
|
|
|
|
|
}->encrypt_hex( $session_key ); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
return $encrypted_session_key; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
618
|
|
|
|
|
|
|
# Take a session key and check that it is still valid; if so, return the user. |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
sub authen_ses_key($$$) |
621
|
|
|
|
|
|
|
{ |
622
|
|
|
|
|
|
|
my( $self, $r, $encrypted_session_key ) = @_; |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
my $auth_name = $r->auth_name; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# Get the configuration information. |
627
|
|
|
|
|
|
|
my %c = _dbi_config_vars $r; |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# Get the secret key. |
630
|
|
|
|
|
|
|
my $secret_key = $SECRET_KEYS{ $auth_name }; |
631
|
|
|
|
|
|
|
unless ( defined $secret_key ) { |
632
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: didn't the secret key from for auth realm $auth_name", $r->uri ); |
633
|
|
|
|
|
|
|
return undef; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# Decrypt the session key. |
637
|
|
|
|
|
|
|
my $session_key; |
638
|
|
|
|
|
|
|
if ( $c{ LDAP_encryptiontype } eq 'none' ) { |
639
|
|
|
|
|
|
|
$session_key = $encrypted_session_key; |
640
|
|
|
|
|
|
|
} else { |
641
|
|
|
|
|
|
|
# Check that this looks like an encrypted hex-encoded string. |
642
|
|
|
|
|
|
|
unless ( $encrypted_session_key =~ /^[0-9a-fA-F]+$/ ) { |
643
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: encrypted session key $encrypted_session_key doesn't look like it's properly hex-encoded for auth realm $auth_name", $r->uri ); |
644
|
|
|
|
|
|
|
return undef; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# Get the cipher from the cache, or create a new one if the |
648
|
|
|
|
|
|
|
# cached cipher hasn't been created, & decrypt the session key. |
649
|
|
|
|
|
|
|
my $cipher; |
650
|
|
|
|
|
|
|
if ( lc $c{ LDAP_encryptiontype } eq 'des' ) { |
651
|
|
|
|
|
|
|
$cipher = $CIPHERS{ "des:$auth_name" } |
652
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'DES' ); |
653
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'idea' ) { |
654
|
|
|
|
|
|
|
$cipher = $CIPHERS{ "idea:$auth_name" } |
655
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'IDEA' ); |
656
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'blowfish' ) { |
657
|
|
|
|
|
|
|
$cipher = $CIPHERS{ "blowfish:$auth_name" } |
658
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'Blowfish' ); |
659
|
|
|
|
|
|
|
} elsif ( lc $c{ LDAP_encryptiontype } eq 'blowfish_pp' ) { |
660
|
|
|
|
|
|
|
$cipher = $CIPHERS{ "blowfish_pp:$auth_name" } |
661
|
|
|
|
|
|
|
||= Crypt::CBC->new( $secret_key, 'Blowfish_PP' ); |
662
|
|
|
|
|
|
|
} else { |
663
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: unknown encryption type $c{ LDAP_encryptiontype } for auth realm $auth_name", $r->uri ); |
664
|
|
|
|
|
|
|
return undef; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
$session_key = $cipher->decrypt_hex( $encrypted_session_key ); |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
# Break up the session key. |
670
|
|
|
|
|
|
|
my( $enc_user, $issue_time, $expire_time, $supplied_hash ) |
671
|
|
|
|
|
|
|
= split /:/, $session_key; |
672
|
|
|
|
|
|
|
# Let's check that we got passed sensible values in the cookie. |
673
|
|
|
|
|
|
|
unless ( $enc_user =~ /^[a-zA-Z0-9_\%]+$/ ) { |
674
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: bad percent-encoded user $enc_user recovered from session ticket for auth_realm $auth_name", $r->uri ); |
675
|
|
|
|
|
|
|
return undef; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
# decode the user |
678
|
|
|
|
|
|
|
my $user = _percent_decode $enc_user; |
679
|
|
|
|
|
|
|
unless ( $issue_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) { |
680
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: bad issue time $issue_time recovered from ticket for user $user for auth_realm $auth_name", $r->uri ); |
681
|
|
|
|
|
|
|
return undef; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
unless ( $expire_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) { |
684
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: bad expire time $expire_time recovered from ticket for user $user for auth_realm $auth_name", $r->uri ); |
685
|
|
|
|
|
|
|
return undef; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
unless ( $supplied_hash =~ /^[0-9a-fA-F]{32}$/ ) { |
688
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: bad hash $supplied_hash recovered from ticket for user $user for auth_realm $auth_name", $r->uri ); |
689
|
|
|
|
|
|
|
return undef; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
# Calculate the hash of the user, issue time, expire_time and |
693
|
|
|
|
|
|
|
# the secret key and then the hash of that and the secret key again. |
694
|
|
|
|
|
|
|
my $hash = md5_hex( join ':', $secret_key, md5_hex( |
695
|
|
|
|
|
|
|
join ':', $enc_user, $issue_time, $expire_time, $secret_key |
696
|
|
|
|
|
|
|
) ); |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# Compare it to the hash they gave us. |
699
|
|
|
|
|
|
|
unless ( $hash eq $supplied_hash ) { |
700
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieLDAP: hash in cookie did not match calculated hash of contents for user $user for auth realm $auth_name", $r->uri ); |
701
|
|
|
|
|
|
|
return undef; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# Check that their session hasn't timed out. |
705
|
|
|
|
|
|
|
if ( _now_year_month_day_hour_minute_second gt $expire_time ) { |
706
|
|
|
|
|
|
|
$r->log_reason( "Apache:AuthCookieLDAP: expire time $expire_time has passed for user $user for auth realm $auth_name", $r->uri ); |
707
|
|
|
|
|
|
|
return undef; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
# If we're being paranoid about timing-out long-lived sessions, |
711
|
|
|
|
|
|
|
# check that the issue time + the current (server-set) session lifetime |
712
|
|
|
|
|
|
|
# hasn't passed too (in case we issued long-lived session tickets |
713
|
|
|
|
|
|
|
# in the past that we want to get rid of). *** DEBUG *** |
714
|
|
|
|
|
|
|
# if ( lc $c{ DBI_AlwaysUseCurrentSessionLifetime } eq 'on' ) { |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
# They must be okay, so return the user. |
717
|
|
|
|
|
|
|
return $user; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
########################################################################### |
721
|
|
|
|
|
|
|
# This is taken from AuthCookieDBI and checks user groups from a database # |
722
|
|
|
|
|
|
|
########################################################################### |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
sub group($$$) |
727
|
|
|
|
|
|
|
{ |
728
|
|
|
|
|
|
|
my( $self, $r, $groups ) = @_; |
729
|
|
|
|
|
|
|
my @groups = split(/\s+/, $groups); |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
my $auth_name = $r->auth_name; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# Get the configuration information. |
734
|
|
|
|
|
|
|
my %c = _dbi_config_vars $r; |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
my $user = $r->connection->user; |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# See if we have a row in the groups table for this user/group. |
739
|
|
|
|
|
|
|
my $dbh = DBI->connect( $c{ DBI_DSN }, |
740
|
|
|
|
|
|
|
$c{ DBI_user }, $c{ DBI_password } ); |
741
|
|
|
|
|
|
|
unless ( defined $dbh ) { |
742
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieDBI: couldn't connect to $c{ DBI_DSN } for auth realm $auth_name", $r->uri ); |
743
|
|
|
|
|
|
|
return undef; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# Now loop through all the groups to see if we're a member of any: |
747
|
|
|
|
|
|
|
my $sth = $dbh->prepare( <<"EOS" ); |
748
|
|
|
|
|
|
|
SELECT $c{ DBI_groupuserfield } |
749
|
|
|
|
|
|
|
FROM $c{ DBI_groupstable } |
750
|
|
|
|
|
|
|
WHERE $c{ DBI_groupfield } = ? |
751
|
|
|
|
|
|
|
AND $c{ DBI_groupuserfield } = ? |
752
|
|
|
|
|
|
|
EOS |
753
|
|
|
|
|
|
|
foreach my $group ( @groups ) { |
754
|
|
|
|
|
|
|
$sth->execute( $group, $user ); |
755
|
|
|
|
|
|
|
return OK if ( $sth->fetchrow_array ); |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
$r->log_reason( "Apache::AuthCookieDBI: user $user was not a member of any of the required groups @groups for auth realm $auth_name", $r->uri ); |
758
|
|
|
|
|
|
|
return FORBIDDEN; |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
1; |
765
|
|
|
|
|
|
|
__END__ |