line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## @file |
2
|
|
|
|
|
|
|
# Auto-protected CGI machanism |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
## @class |
5
|
|
|
|
|
|
|
# Base class for auto-protected CGI |
6
|
|
|
|
|
|
|
package Lemonldap::NG::Handler::CGI; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
1514
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
195
|
use Lemonldap::NG::Common::CGI; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Lemonldap::NG::Common::Session; |
12
|
|
|
|
|
|
|
use CGI::Cookie; |
13
|
|
|
|
|
|
|
use MIME::Base64; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use base qw(Lemonldap::NG::Common::CGI); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Lemonldap::NG::Handler::SharedConf qw(:all); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
#link Lemonldap::NG::Handler::_CGI protected _handler |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '1.4.1'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
## @cmethod Lemonldap::NG::Handler::CGI new(hashRef args) |
24
|
|
|
|
|
|
|
# Constructor. |
25
|
|
|
|
|
|
|
# @param $args hash passed to Lemonldap::NG::Handler::_CGI object |
26
|
|
|
|
|
|
|
# @return new object |
27
|
|
|
|
|
|
|
sub new { |
28
|
|
|
|
|
|
|
my $class = shift; |
29
|
|
|
|
|
|
|
my $self = $class->SUPER::new() or $class->abort("Unable to build CGI"); |
30
|
|
|
|
|
|
|
$Lemonldap::NG::Handler::_CGI::_cgi = $self; |
31
|
|
|
|
|
|
|
unless ( $Lemonldap::NG::Handler::_CGI::tsv->{cookieName} ) { |
32
|
|
|
|
|
|
|
Lemonldap::NG::Handler::_CGI->init(@_); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
#Lemonldap::NG::Handler::_CGI->initLocalStorage(@_); # already called by _CGI->init() |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
unless ( eval { Lemonldap::NG::Handler::_CGI->testConf() } == OK ) { |
37
|
|
|
|
|
|
|
if ( $_[0]->{noAbort} ) { |
38
|
|
|
|
|
|
|
$self->{_noConf} = $@; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
else { |
41
|
|
|
|
|
|
|
$class->abort( "Unable to get configuration", $@ ); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Arguments |
46
|
|
|
|
|
|
|
my @args = splice @_; |
47
|
|
|
|
|
|
|
if ( ref( $args[0] ) ) { |
48
|
|
|
|
|
|
|
%$self = ( %$self, %{ $args[0] } ); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
else { |
51
|
|
|
|
|
|
|
%$self = ( %$self, @args ); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Protection |
55
|
|
|
|
|
|
|
if ( $self->{protection} and $self->{protection} ne 'none' ) { |
56
|
|
|
|
|
|
|
$self->authenticate(); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# ACCOUNTING |
59
|
|
|
|
|
|
|
if ( $self->{protection} =~ /^manager$/i ) { |
60
|
|
|
|
|
|
|
$self->authorize() |
61
|
|
|
|
|
|
|
or $self->abort( 'Forbidden', |
62
|
|
|
|
|
|
|
"You don't have rights to access this page" ); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
elsif ( $self->{protection} =~ /rule\s*:\s*(.*)\s*$/i ) { |
65
|
|
|
|
|
|
|
my $rule = $1; |
66
|
|
|
|
|
|
|
$rule =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e; |
67
|
|
|
|
|
|
|
$rule =~ s/\$(\w+)/\$datas->{$1}/g; |
68
|
|
|
|
|
|
|
$rule = 0 if ( $rule eq 'deny' ); |
69
|
|
|
|
|
|
|
my $r; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
unless ( $rule eq 'accept' |
72
|
|
|
|
|
|
|
or Lemonldap::NG::Handler::_CGI->safe_reval($rule) ) |
73
|
|
|
|
|
|
|
{ |
74
|
|
|
|
|
|
|
$self->abort( 'Forbidden', |
75
|
|
|
|
|
|
|
"You don't have rights to access this page" ); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
elsif ( $self->{protection} !~ /^authenticate$/i ) { |
79
|
|
|
|
|
|
|
$self->abort( |
80
|
|
|
|
|
|
|
'Bad configuration', |
81
|
|
|
|
|
|
|
"The rule " . $self->{protection} . " is not known" |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
return $self; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
## @method boolean authenticate() |
89
|
|
|
|
|
|
|
# Checks if user session is valid. |
90
|
|
|
|
|
|
|
# Checks Lemonldap::NG cookie and search session in sessions database. |
91
|
|
|
|
|
|
|
# If nothing is found, redirects the user to the Lemonldap::NG portal. |
92
|
|
|
|
|
|
|
# @return boolean : true if authentication is good. Exit before else |
93
|
|
|
|
|
|
|
sub authenticate { |
94
|
|
|
|
|
|
|
my $self = shift; |
95
|
|
|
|
|
|
|
$self->abort( |
96
|
|
|
|
|
|
|
"Can't authenticate because configuration has not been loaded", |
97
|
|
|
|
|
|
|
$self->{_noConf} ) |
98
|
|
|
|
|
|
|
if ( $self->{_noConf} ); |
99
|
|
|
|
|
|
|
my %cookies = fetch CGI::Cookie; |
100
|
|
|
|
|
|
|
my $id; |
101
|
|
|
|
|
|
|
unless ($cookies{ $tsv->{cookieName} } |
102
|
|
|
|
|
|
|
and $id = $cookies{ $tsv->{cookieName} }->value ) |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
return $self->goToPortal(); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
unless ( $datas and $id eq $datas->{_session_id} ) { |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my $apacheSession = Lemonldap::NG::Common::Session->new( |
109
|
|
|
|
|
|
|
{ |
110
|
|
|
|
|
|
|
storageModule => $tsv->{globalStorage}, |
111
|
|
|
|
|
|
|
storageModuleOptions => $tsv->{globalStorageOptions}, |
112
|
|
|
|
|
|
|
cacheModule => $tsv->{localSessionStorage}, |
113
|
|
|
|
|
|
|
cacheModuleOptions => $tsv->{localSessionStorageOptions}, |
114
|
|
|
|
|
|
|
id => $id, |
115
|
|
|
|
|
|
|
kind => "SSO", |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
if ( $apacheSession->error ) { |
120
|
|
|
|
|
|
|
Lemonldap::NG::Handler::Main::Logger->lmLog( |
121
|
|
|
|
|
|
|
"Session $id can't be retrieved", 'info' ); |
122
|
|
|
|
|
|
|
Lemonldap::NG::Handler::Main::Logger->lmLog( $apacheSession->error, |
123
|
|
|
|
|
|
|
'info' ); |
124
|
|
|
|
|
|
|
return $self->goToPortal(); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
$datas->{$_} = $apacheSession->data->{$_} |
128
|
|
|
|
|
|
|
foreach ( keys %{ $apacheSession->data } ); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Accounting : set user in apache logs |
132
|
|
|
|
|
|
|
$self->setApacheUser( $datas->{ $tsv->{whatToTrace} } ); |
133
|
|
|
|
|
|
|
$ENV{REMOTE_USER} = $datas->{ $tsv->{whatToTrace} }; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
return 1; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
## @method boolean authorize() |
139
|
|
|
|
|
|
|
# Checks if user is authorized to access to the current request. |
140
|
|
|
|
|
|
|
# Call Lemonldap::NG::Handler::_CGI::grant() function. |
141
|
|
|
|
|
|
|
# @return boolean : true if user is granted |
142
|
|
|
|
|
|
|
sub authorize { |
143
|
|
|
|
|
|
|
my $self = shift; |
144
|
|
|
|
|
|
|
return Lemonldap::NG::Handler::_CGI->grant( $ENV{REQUEST_URI} ); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
## @method int testUri(string uri) |
148
|
|
|
|
|
|
|
# Checks if user is authorized to access to $uri. |
149
|
|
|
|
|
|
|
# Call Lemonldap::NG::Handler::_CGI::grant() function. |
150
|
|
|
|
|
|
|
# @param $uri URI or URL to test |
151
|
|
|
|
|
|
|
# @return int : 1 if user is granted, -1 if virtual host has no configuration, |
152
|
|
|
|
|
|
|
# 0 if user isn't granted |
153
|
|
|
|
|
|
|
sub testUri { |
154
|
|
|
|
|
|
|
my $self = shift; |
155
|
|
|
|
|
|
|
$self->abort( "Can't test URI because configuration has not been loaded", |
156
|
|
|
|
|
|
|
$self->{_noConf} ) |
157
|
|
|
|
|
|
|
if ( $self->{_noConf} ); |
158
|
|
|
|
|
|
|
my $uri = shift; |
159
|
|
|
|
|
|
|
my $host = |
160
|
|
|
|
|
|
|
( $uri =~ s#^(?:https?://)?([^/]*)/#/# ) ? $1 : $ENV{SERVER_NAME}; |
161
|
|
|
|
|
|
|
return -1 unless ( Lemonldap::NG::Handler::_CGI->vhostAvailable($host) ); |
162
|
|
|
|
|
|
|
return Lemonldap::NG::Handler::_CGI->grant( $uri, $host ); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
## @method hashRef user() |
166
|
|
|
|
|
|
|
# @return hash of user datas |
167
|
|
|
|
|
|
|
sub user { |
168
|
|
|
|
|
|
|
return $datas; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
## @method boolean group(string group) |
172
|
|
|
|
|
|
|
# @param $group name of the Lemonldap::NG group to test |
173
|
|
|
|
|
|
|
# @return boolean : true if user is in this group |
174
|
|
|
|
|
|
|
sub group { |
175
|
|
|
|
|
|
|
my ( $self, $group ) = splice @_; |
176
|
|
|
|
|
|
|
return ( $datas->{groups} =~ /\b$group\b/ ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
## @method void goToPortal() |
180
|
|
|
|
|
|
|
# Redirects the user to the portal and exit. |
181
|
|
|
|
|
|
|
sub goToPortal { |
182
|
|
|
|
|
|
|
my $self = shift; |
183
|
|
|
|
|
|
|
my $tmp = encode_base64( $self->_uri, '' ); |
184
|
|
|
|
|
|
|
print CGI::redirect( |
185
|
|
|
|
|
|
|
-uri => Lemonldap::NG::Handler::_CGI->portal() . "?url=$tmp" ); |
186
|
|
|
|
|
|
|
exit; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
## @fn private string _uri() |
190
|
|
|
|
|
|
|
# Builds current URL including "http://" and server name. |
191
|
|
|
|
|
|
|
# @return URL_string |
192
|
|
|
|
|
|
|
sub _uri { |
193
|
|
|
|
|
|
|
my $vhost = $ENV{SERVER_NAME}; |
194
|
|
|
|
|
|
|
my $portString = |
195
|
|
|
|
|
|
|
$tsv->{port}->{$vhost} |
196
|
|
|
|
|
|
|
|| $tsv->{port}->{_} |
197
|
|
|
|
|
|
|
|| $ENV{SERVER_PORT}; |
198
|
|
|
|
|
|
|
my $_https = ( |
199
|
|
|
|
|
|
|
defined( $tsv->{https}->{$vhost} ) |
200
|
|
|
|
|
|
|
? $tsv->{https}->{$vhost} |
201
|
|
|
|
|
|
|
: $tsv->{https}->{_} |
202
|
|
|
|
|
|
|
); |
203
|
|
|
|
|
|
|
$portString = |
204
|
|
|
|
|
|
|
( $_https && $portString == 443 ) ? '' |
205
|
|
|
|
|
|
|
: ( !$_https && $portString == 80 ) ? '' |
206
|
|
|
|
|
|
|
: ':' . $portString; |
207
|
|
|
|
|
|
|
my $url = "http" |
208
|
|
|
|
|
|
|
. ( $_https ? "s" : "" ) . "://" |
209
|
|
|
|
|
|
|
. $vhost |
210
|
|
|
|
|
|
|
. $portString |
211
|
|
|
|
|
|
|
. $ENV{REQUEST_URI}; |
212
|
|
|
|
|
|
|
return $url; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
## @class |
216
|
|
|
|
|
|
|
# Private class used by Lemonldap::NG::Handler::CGI for his internal handler. |
217
|
|
|
|
|
|
|
package Lemonldap::NG::Handler::_CGI; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
use strict; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
#use Lemonldap::NG::Handler::SharedConf qw(:locationRules :localStorage :traces); |
222
|
|
|
|
|
|
|
use Lemonldap::NG::Handler::SharedConf qw(:tsv :ntsv :jailSharedVars); |
223
|
|
|
|
|
|
|
use Lemonldap::NG::Handler::Main::Jail; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
use base qw(Lemonldap::NG::Handler::SharedConf); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
our $_cgi; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub safe_reval { |
230
|
|
|
|
|
|
|
my $class = shift; |
231
|
|
|
|
|
|
|
my $rule = shift; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
my $jail = Lemonldap::NG::Handler::Main::Jail->new( |
234
|
|
|
|
|
|
|
'safe' => $ntsv->{safe}, |
235
|
|
|
|
|
|
|
'useSafeJail' => $tsv->{useSafeJail}, |
236
|
|
|
|
|
|
|
'customFunctions' => $tsv->{customFunctions} |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
$ntsv->{safe} = $jail->build_safe(); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
return $ntsv->{safe}->reval($rule); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
## @method boolean childInit() |
244
|
|
|
|
|
|
|
# Since this is not a real Apache handler, childs have not to be initialized. |
245
|
|
|
|
|
|
|
# @return true |
246
|
|
|
|
|
|
|
sub childInit { 1 } |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
## @method boolean purgeCache() |
249
|
|
|
|
|
|
|
# Since this is not a real Apache handler, it must not purge the cache at starting. |
250
|
|
|
|
|
|
|
# @return true |
251
|
|
|
|
|
|
|
sub purgeCache { 1 } |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
## @method void lmLog(string message,string level) |
254
|
|
|
|
|
|
|
# Replace lmLog by "print STDERR $message". |
255
|
|
|
|
|
|
|
# @param $message Message to log |
256
|
|
|
|
|
|
|
# @param $level error level (debug, info, warning or error) |
257
|
|
|
|
|
|
|
sub lmLog { |
258
|
|
|
|
|
|
|
my $class = shift; |
259
|
|
|
|
|
|
|
$_cgi->lmLog(@_); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
## @method boolean vhostAvailable(string vhost) |
263
|
|
|
|
|
|
|
# Checks if $vhost has been declared in configuration |
264
|
|
|
|
|
|
|
# @param $vhost Virtual Host to test |
265
|
|
|
|
|
|
|
# @return boolean : true if $vhost is available |
266
|
|
|
|
|
|
|
sub vhostAvailable { |
267
|
|
|
|
|
|
|
my ( $self, $vhost ) = splice @_; |
268
|
|
|
|
|
|
|
return defined( $tsv->{defaultCondition}->{$vhost} ); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
## @method boolean grant(string uri, string vhost) |
272
|
|
|
|
|
|
|
# Return true if user is granted to access. |
273
|
|
|
|
|
|
|
# @param $uri URI string |
274
|
|
|
|
|
|
|
# @param $vhost Optional virtual host (default current virtual host) |
275
|
|
|
|
|
|
|
sub grant { |
276
|
|
|
|
|
|
|
my ( $self, $uri, $vhost ) = splice @_; |
277
|
|
|
|
|
|
|
$vhost ||= $ENV{SERVER_NAME}; |
278
|
|
|
|
|
|
|
$apacheRequest = Lemonldap::NG::Apache::Request->new( |
279
|
|
|
|
|
|
|
{ |
280
|
|
|
|
|
|
|
uri => $uri, |
281
|
|
|
|
|
|
|
hostname => $vhost, |
282
|
|
|
|
|
|
|
args => '', |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
); |
285
|
|
|
|
|
|
|
for ( my $i = 0 ; $i < $tsv->{locationCount}->{$vhost} ; $i++ ) { |
286
|
|
|
|
|
|
|
if ( $uri =~ $tsv->{locationRegexp}->{$vhost}->[$i] ) { |
287
|
|
|
|
|
|
|
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }($datas); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
unless ( $tsv->{defaultCondition}->{$vhost} ) { |
291
|
|
|
|
|
|
|
$self->lmLog( |
292
|
|
|
|
|
|
|
"User rejected because VirtualHost \"$vhost\" has no configuration", |
293
|
|
|
|
|
|
|
'warn' |
294
|
|
|
|
|
|
|
); |
295
|
|
|
|
|
|
|
return 0; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
return &{ $tsv->{defaultCondition}->{$vhost} }($datas); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
package Lemonldap::NG::Apache::Request; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub new { |
303
|
|
|
|
|
|
|
my $class = shift; |
304
|
|
|
|
|
|
|
my $self = shift; |
305
|
|
|
|
|
|
|
return bless $self, $class; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub hostname { |
309
|
|
|
|
|
|
|
return $_[0]->{hostname}; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub uri { |
313
|
|
|
|
|
|
|
return $_[0]->{uri}; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub args { |
317
|
|
|
|
|
|
|
return $_[0]->{args}; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
1; |
321
|
|
|
|
|
|
|
__END__ |