Process.pm 13 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
package Lemonldap::NG::Portal::Main::Process;

Yadd's avatar
Yadd committed
3
4
5
6
our $VERSION = '2.0.0';

package Lemonldap::NG::Portal::Main;

Yadd's avatar
Yadd committed
7
use strict;
Yadd's avatar
Yadd committed
8
use MIME::Base64;
Yadd's avatar
Yadd committed
9
use POSIX qw(strftime);
Yadd's avatar
Yadd committed
10

Yadd's avatar
Yadd committed
11
12
13
14
15
16
17
18
19
20
21
22
23
# Main method
# -----------
# Launch all methods declared in request "steps" array. Methods can be
# declared by their name (in Lemonldap::NG::Portal::Main namespace) or point
# to a subroutine (see Lemonldap::NG::Portal::Main::Run.pm)

sub process {
    my ( $self, $req ) = @_;

    #$req->error(PE_OK);
    my $err = PE_OK;
    while ( my $sub = shift @{ $req->steps } ) {
        if ( ref $sub ) {
Yadd's avatar
Yadd committed
24
            $self->lmLog( "Processing code ref", 'debug' );
Yadd's avatar
Yadd committed
25
            last if ( $err = $sub->($req) );
Yadd's avatar
Yadd committed
26
27
        }
        else {
Yadd's avatar
Yadd committed
28
            $self->lmLog( "Processing $sub", 'debug' );
Yadd's avatar
Yadd committed
29
30
31
            last if ( $err = $self->$sub($req) );
        }
    }
Yadd's avatar
Yadd committed
32
    $self->lmLog( "Returned error: $err", 'debug' ) if ($err);
Yadd's avatar
Yadd committed
33
34
35
    return $err;
}

Yadd's avatar
Yadd committed
36
37
38
39
40
41
42
# First process block: check args
# -------------------------------

# For post requests, parse datas
sub restoreArgs {
    my ( $self, $req ) = @_;
    $req->parseBody;
Yadd's avatar
Yadd committed
43
    $req->mustRedirect(1);
44
    return PE_OK;
Yadd's avatar
Yadd committed
45
46
}

Yadd's avatar
Yadd committed
47
48
sub importHandlerDatas {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
49
    $req->{sessionInfo} = $req->userData;
Yadd's avatar
Yadd committed
50
    $req->id( $req->sessionInfo->{_session_id} );
Yadd's avatar
Yadd committed
51
    $req->user( $req->sessionInfo->{ $self->conf->{whatToTrace} } );
Yadd's avatar
Yadd committed
52
53
54
    PE_OK;
}

Yadd's avatar
Yadd committed
55
56
57
# Verify url parameter
sub controlUrl {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
58
    $req->{datas}->{_url} ||= '';
Yadd's avatar
Yadd committed
59
60
    if ( my $url = $req->param('url') ) {

Yadd's avatar
Yadd committed
61
62
        # REJECT NON BASE64 URL
        if ( $req->urlNotBase64 ) {
Yadd's avatar
Yadd committed
63
            $req->{urldc} = $url;
Yadd's avatar
Yadd committed
64
65
        }
        else {
Yadd's avatar
Yadd committed
66
67
68
69
70
71
            if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
                $self->lmLog(
                    "Value must be in BASE64 (param: url | value: $url)",
                    "warn" );
                return PE_BADURL;
            }
Yadd's avatar
Yadd committed
72
73
            $req->{urldc} = decode_base64($url);
            $req->{urldc} =~ s/[\r\n]//sg;
Yadd's avatar
Yadd committed
74
75
76
        }

        # For logout request, test if Referer comes from an authorizated site
Yadd's avatar
Yadd committed
77
78
        my $tmp = (
              $req->param('logout')
Yadd's avatar
Yadd committed
79
            ? $req->referer
Yadd's avatar
Yadd committed
80
            : $req->{urldc}
Yadd's avatar
Yadd committed
81
        );
Yadd's avatar
Yadd committed
82
83
84
85
86

        # XSS attack
        if (
            $self->checkXSSAttack(
                $req->param('logout') ? 'HTTP Referer' : 'urldc',
Yadd's avatar
Yadd committed
87
                $req->{urldc}
Yadd's avatar
Yadd committed
88
89
90
            )
          )
        {
Yadd's avatar
Yadd committed
91
            delete $req->{urldc};
Yadd's avatar
Yadd committed
92
93
94
95
96
97
98
99
100
101
102
            return PE_BADURL;
        }

        # Non protected hosts
        if ( $tmp and !$self->isTrustedUrl($tmp) ) {
            $self->lmLog(
                "URL contains a non protected host (param: "
                  . ( $req->param('logout') ? 'HTTP Referer' : 'urldc' )
                  . " | value: $tmp)",
                "warn"
            );
Yadd's avatar
Yadd committed
103
            delete $req->{urldc};
Yadd's avatar
Yadd committed
104
105
106
107
108
109
110
111
112
            return PE_BADURL;
        }

        $req->datas->{_url} = $url;
    }

    PE_OK;
}

Yadd's avatar
Yadd committed
113
114
115
sub checkLogout {
    my ( $self, $req ) = @_;
    if ( $req->param('logout') ) {
Yadd's avatar
Yadd committed
116
117
        $req->steps(
            [ @{ $self->beforeLogout }, 'authLogout', 'deleteSession' ] );
Yadd's avatar
Yadd committed
118
119
120
121
    }
    PE_OK;
}

Yadd's avatar
Yadd committed
122
sub authLogout {
Yadd's avatar
Yadd committed
123
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
124
    return $self->_authentication->authLogout($req);
Yadd's avatar
Yadd committed
125
126
}

Yadd's avatar
Yadd committed
127
128
129
sub deleteSession {
    my ( $self, $req ) = @_;
    my $apacheSession = $self->getApacheSession( $req->id );
Yadd's avatar
Yadd committed
130
    my $id            = $req->id;
Yadd's avatar
Yadd committed
131
132
133
134
    unless ($apacheSession) {
        $self->lmLog( "Session $id already deleted", 'debug' );
        return PE_OK;
    }
Yadd's avatar
Yadd committed
135
    unless ( $self->_deleteSession( $req, $apacheSession ) ) {
Yadd's avatar
Yadd committed
136
        $self->lmLog( "Unable to delete session $id", 'error' );
Yadd's avatar
Yadd committed
137
        $self->lmLog( $apacheSession->error,          'error' );
Yadd's avatar
Yadd committed
138
139
140
        return PE_ERROR;
    }
    else {
Yadd's avatar
Yadd committed
141
        $self->lmLog( "Session $id deleted from global storage", 'debug' );
Yadd's avatar
Yadd committed
142
143
    }

Yadd's avatar
Yadd committed
144
    # TODO
Yadd's avatar
Yadd committed
145
    # Collect logout services and build hidden iFrames
Yadd's avatar
Yadd committed
146
147
    if ( $req->datas->{logoutServices} and %{ $req->datas->{logoutServices} } )
    {
Yadd's avatar
Yadd committed
148

Yadd's avatar
Yadd committed
149
        $self->lmLog( "Create iFrames to forward logout to services", 'debug' );
Yadd's avatar
Yadd committed
150

Yadd's avatar
Yadd committed
151
        $self->info( $req, '<h3 trmsg="logoutFromOtherApp"></h3>' );
Yadd's avatar
Yadd committed
152

Yadd's avatar
Yadd committed
153
154
155
156
        foreach ( keys %{ $req->datas->{logoutServices} } ) {
            my $logoutServiceName = $_;
            my $logoutServiceUrl =
              $req->datas->{logoutServices}->{$logoutServiceName};
Yadd's avatar
Yadd committed
157

Yadd's avatar
Yadd committed
158
            $self->lmLog(
Yadd's avatar
Yadd committed
159
                "Find logout service $logoutServiceName ($logoutServiceUrl)",
Yadd's avatar
Yadd committed
160

Yadd's avatar
Yadd committed
161
162
                'debug'
            );
Yadd's avatar
Yadd committed
163

Yadd's avatar
Yadd committed
164
165
166
167
168
169
            my $iframe =
                "<iframe src=\"$logoutServiceUrl\""
              . " alt=\"$logoutServiceName\" marginwidth=\"0\""
              . " marginheight=\"0\" scrolling=\"no\" style=\"border: none;display: hidden;margin: 0\""
              . " width=\"0\" height=\"0\" frameborder=\"0\">"
              . "</iframe>";
Yadd's avatar
Yadd committed
170

Yadd's avatar
Yadd committed
171
            $self->info( $req, $iframe );
Yadd's avatar
Yadd committed
172
        }
Yadd's avatar
Yadd committed
173

Yadd's avatar
Yadd committed
174
175
        # Redirect on logout page if no other target defined
        if ( !$req->urldc and !$req->postUrl ) {
Yadd's avatar
Yadd committed
176
177
            $self->lmLog( 'No other target defined, redirect on logout',
                'debug' );
Yadd's avatar
Yadd committed
178
179
180
            $req->urldc( $req->scriptname . "?logout=1" );
        }
    }
Yadd's avatar
Yadd committed
181

Yadd's avatar
Yadd committed
182
    # Redirect or Post if asked by authLogout
Yadd's avatar
Yadd committed
183
184
185
186
    if ( $req->urldc and $req->urldc ne $self->conf->{portal} ) {
        $req->steps( [] );
        return PE_REDIRECT;
    }
Yadd's avatar
Yadd committed
187

Yadd's avatar
Yadd committed
188
189
190
191
    if ( $req->postUrl ) {
        $req->steps( ['autoPost'] );
        return PE_OK;
    }
Yadd's avatar
Yadd committed
192

Yadd's avatar
Yadd committed
193
194
195
196
197
    # If logout redirects to another URL, just remove next steps for the
    # request so autoRedirect will be called
    if ( $req->{urldc} and $req->{urldc} ne $self->conf->{portal} ) {
        $req->steps( [] );
        return PE_OK;
Yadd's avatar
Yadd committed
198
199
    }

Yadd's avatar
Yadd committed
200
201
    # Else display "error"
    return PE_LOGOUT_OK;
Yadd's avatar
Yadd committed
202
203
}

Yadd's avatar
Yadd committed
204
205
206
207
208
209
210
211
212
213
214
# Check value to detect XSS attack
# @param name Parameter name
# @param value Parameter value
# @return 1 if attack detected, 0 else
sub checkXSSAttack {
    my ( $self, $name, $value ) = @_;

    # Empty values are not bad
    return 0 unless $value;

    # Test value
Yadd's avatar
Yadd committed
215
216
    $value =~ s/\%25/\%/g;
    if ( $value =~ m/(?:\0|<|'|"|`|\%(?:00|3C|22|27|2C))/ ) {
Yadd's avatar
Yadd committed
217
218
219
220
221
222
223
224
        $self->lmLog( "XSS attack detected (param: $name | value: $value)",
            "warn" );
        return $self->conf->{checkXSS};
    }

    return 0;
}

Yadd's avatar
Yadd committed
225
226
227
# Second block: auth process (call auth or userDB object)
# -------------------------------------------------------

Yadd's avatar
Yadd committed
228
sub extractFormInfo {
Yadd's avatar
Yadd committed
229
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
230
    my $ret = $self->_authentication->extractFormInfo($req);
Yadd's avatar
Yadd committed
231
    if ( $ret == PE_OK and not( $req->user or $req->continue ) ) {
232
233
234
        $self->lmLog(
            'Authentication module succeed but has not set $req->user',
            'error' );
Yadd's avatar
Yadd committed
235
236
237
        return PE_ERROR;
    }
    return $ret;
Yadd's avatar
Yadd committed
238
239
240
}

sub getUser {
Yadd's avatar
Yadd committed
241
242
    my ( $self, $req ) = @_;
    return $self->_userDB->getUser($req);
Yadd's avatar
Yadd committed
243
244
245
}

sub authenticate {
Yadd's avatar
Yadd committed
246
247
    my ( $self, $req ) = @_;
    return $self->_authentication->authenticate($req);
Yadd's avatar
Yadd committed
248
249
}

Yadd's avatar
Yadd committed
250
251
# Third block: Session data providing
# -----------------------------------
Yadd's avatar
Yadd committed
252

Yadd's avatar
Yadd committed
253
254
255
sub setAuthSessionInfo {
    my ( $self, $req ) = @_;
    my $ret = $self->_authentication->setAuthSessionInfo($req);
Yadd's avatar
Yadd committed
256
257
258
    if ( $ret == PE_OK
        and not( defined $req->sessionInfo->{authenticationLevel} ) )
    {
Yadd's avatar
Yadd committed
259
260
261
262
263
264
        $self->lmLog( 'Authentication level is not set by auth module',
            'error' );
    }
    return $ret;
}

Yadd's avatar
Yadd committed
265
266
267
sub setSessionInfo {
    my ( $self, $req ) = @_;

Yadd's avatar
Yadd committed
268
    # Set _user
Yadd's avatar
Yadd committed
269
    $req->{sessionInfo}->{_user} //= $req->{user};
Yadd's avatar
Yadd committed
270

Yadd's avatar
Yadd committed
271
    # Get the current user module
Yadd's avatar
Yadd committed
272
273
    $req->{sessionInfo}->{_auth}   = $self->getModule( $req, "auth" );
    $req->{sessionInfo}->{_userDB} = $self->getModule( $req, "user" );
Yadd's avatar
Yadd committed
274
275
276
277
278
279
280
281
282
283
284
285
286

    # Store IP address from remote address or X-FORWARDED-FOR header
    $req->{sessionInfo}->{ipAddr} = $req->remote_ip;

    # Date and time
    if ( $self->conf->{updateSession} ) {
        $req->{sessionInfo}->{updateTime} =
          strftime( "%Y%m%d%H%M%S", localtime() );
    }
    else {
        $req->{sessionInfo}->{_utime} ||= time();
        $req->{sessionInfo}->{startTime} =
          strftime( "%Y%m%d%H%M%S", localtime() );
Yadd's avatar
Yadd committed
287
288
        $req->{sessionInfo}->{_lastSeen} = time()
          if $self->conf->{timeoutActivity};
Yadd's avatar
Yadd committed
289
290
    }

Yadd's avatar
Yadd committed
291
292
    # Get environment variables matching exportedVars (works only with HTTP_*
    # and SSL_*: see Main/Request.pm)
Yadd's avatar
Yadd committed
293
    foreach ( keys %{ $self->conf->{exportedVars} } ) {
Yadd's avatar
Yadd committed
294
        if ( my $tmp = $req->{ $self->conf->{exportedVars}->{$_} } ) {
Yadd's avatar
Yadd committed
295
296
297
298
299
300
            $tmp =~ s/[\r\n]/ /gs;
            $req->{sessionInfo}->{$_} = $tmp;
        }
    }

    # Store URL origin in session
Yadd's avatar
Yadd committed
301
    $req->{sessionInfo}->{_url} = $req->{urldc};
Yadd's avatar
Yadd committed
302

303
    # Share sessionInfo with underlying handler (needed for safe jail)
Yadd's avatar
Yadd committed
304
    $req->userData( $req->sessionInfo );
305

Yadd's avatar
Yadd committed
306
    # Call UserDB setSessionInfo
Yadd's avatar
Yadd committed
307
    return $self->_userDB->setSessionInfo($req);
Yadd's avatar
Yadd committed
308
309
310
311
312

    PE_OK;
}

sub setMacros {
Yadd's avatar
Yadd committed
313
314
    my ( $self, $req ) = @_;
    foreach ( sort keys %{ $self->_macros } ) {
Yadd's avatar
Yadd committed
315
316
        $req->{sessionInfo}->{$_} =
          $self->_macros->{$_}->( $req->sessionInfo );
Yadd's avatar
Yadd committed
317
318
    }
    PE_OK;
Yadd's avatar
Yadd committed
319
320
321
}

sub setGroups {
Yadd's avatar
Yadd committed
322
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
323
    return $self->_userDB->setGroups($req);
Yadd's avatar
Yadd committed
324
325
326
}

sub setPersistentSessionInfo {
Yadd's avatar
Yadd committed
327
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
328

Yadd's avatar
Yadd committed
329
330
331
    # Do not restore infos if session already opened
    unless ( $req->{id} ) {
        my $key = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
Yadd's avatar
Yadd committed
332

Yadd's avatar
Yadd committed
333
        return PE_OK unless ( $key and length($key) );
Yadd's avatar
Yadd committed
334

Yadd's avatar
Yadd committed
335
        my $persistentSession = $self->getPersistentSession($key);
Yadd's avatar
Yadd committed
336

Yadd's avatar
Yadd committed
337
338
339
        if ($persistentSession) {
            $self->lmLog( "Persistent session found for $key", 'debug' );
            foreach my $k ( keys %{ $persistentSession->data } ) {
Yadd's avatar
Yadd committed
340

Yadd's avatar
Yadd committed
341
342
343
344
345
346
347
                # Do not restore some parameters
                next if $k =~ /^_(?:utime|session_(?:u?id|kind))$/;
                $self->lmLog( "Restore persistent parameter $k", 'debug' );
                $req->{sessionInfo}->{$k} = $persistentSession->data->{$k};
            }
        }
    }
Yadd's avatar
Yadd committed
348

Yadd's avatar
Yadd committed
349
    PE_OK;
Yadd's avatar
Yadd committed
350
351
352
}

sub setLocalGroups {
Yadd's avatar
Yadd committed
353
354
    my ( $self, $req ) = @_;
    foreach ( sort keys %{ $self->_groups } ) {
Yadd's avatar
Yadd committed
355
        if ( $self->_groups->{$_}->( $req->sessionInfo ) ) {
Yadd's avatar
Yadd committed
356
357
358
359
360
361
362
363
364
            $req->{sessionInfo}->{groups} .=
              $self->conf->{multiValuesSeparator} . $_;
            $req->{sessionInfo}->{hGroups}->{$_}->{name} = $_;
        }
    }

    # Clear values separator at the beginning
    if ( $req->{sessionInfo}->{groups} ) {
        $req->{sessionInfo}->{groups} =~
Yadd's avatar
Yadd committed
365
          s/^$self->conf->{multiValuesSeparator}//o;
Yadd's avatar
Yadd committed
366
367
    }
    PE_OK;
Yadd's avatar
Yadd committed
368
369
370
}

sub store {
Yadd's avatar
Yadd committed
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
    my ( $self, $req ) = @_;

    # Now, user is authenticated => inform handler
    $req->userData( $req->sessionInfo );

    # Create second session for unsecure cookie
    if ( $self->conf->{securedCookie} == 2 ) {
        my $session2 = $self->getApacheSession( undef, 1 );

        my %infos = %{ $req->{sessionInfo} };
        $infos{_httpSessionType} = 1;

        $session2->update( \%infos );

        $req->{sessionInfo}->{_httpSession} = $session2->id;
    }

    # Main session
    my $session = $self->getApacheSession( $req->{id}, 0, $self->{force} );
    return PE_APACHESESSIONERROR unless ($session);
Yadd's avatar
Yadd committed
391
    $req->id( $session->{id} );
Yadd's avatar
Yadd committed
392
393
394
395
396
397
398
399
400
401
402
403

    # Compute unsecure cookie value if needed
    if ( $self->conf->{securedCookie} == 3 ) {
        $req->{sessionInfo}->{_httpSession} =
          $self->conf->{cipher}->encryptHex( $self->{id}, "http" );
    }

    # Fill session
    my $infos = {};
    foreach my $k ( keys %{ $req->{sessionInfo} } ) {
        next unless defined $req->{sessionInfo}->{$k};
        my $displayValue = $req->{sessionInfo}->{$k};
Yadd's avatar
Yadd committed
404
405
406
        if (    $self->conf->{hiddenAttributes}
            and $self->conf->{hiddenAttributes} =~ /\b$k\b/ )
        {
Yadd's avatar
Yadd committed
407
408
409
410
            $displayValue = '****';
        }
        $self->lmLog( "Store $displayValue in session key $k", 'debug' );
        $self->_dump($displayValue) if ref($displayValue);
Yadd's avatar
Yadd committed
411
        $infos->{$k} = $req->{sessionInfo}->{$k};
Yadd's avatar
Yadd committed
412
413
414
415
    }
    $session->update($infos);

    PE_OK;
Yadd's avatar
Yadd committed
416
417
418
}

sub buildCookie {
Yadd's avatar
Yadd committed
419
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
420
421
422
423
424
    push @{ $req->respHeaders },
      'Set-Cookie' => $self->cookie(
        name     => $self->conf->{cookieName},
        value    => $req->{id},
        domain   => $self->conf->{domain},
Yadd's avatar
Yadd committed
425
        path     => "/",
Yadd's avatar
Yadd committed
426
427
428
        secure   => $self->conf->{securedCookie},
        HttpOnly => $self->conf->{httpOnly},
        expires  => $self->conf->{cookieExpiration},
Yadd's avatar
Yadd committed
429
430
      );
    if ( $self->conf->{securedCookie} >= 2 ) {
Yadd's avatar
Yadd committed
431
432
433
434
435
        push @{ $req->respHeaders },
          'Set-Cookie' => $self->cookie(
            name     => $self->conf->{cookieName} . "http",
            value    => $req->{sessionInfo}->{_httpSession},
            domain   => $self->conf->{domain},
Yadd's avatar
Yadd committed
436
437
            path     => "/",
            secure   => 0,
Yadd's avatar
Yadd committed
438
439
            HttpOnly => $self->conf->{httpOnly},
            expires  => $self->conf->{cookieExpiration},
Yadd's avatar
Yadd committed
440
441
442
          );
    }
    PE_OK;
Yadd's avatar
Yadd committed
443
444
445
}

sub cookie {
Yadd's avatar
Yadd committed
446
447
448
449
450
451
    my ( $self, %h ) = @_;
    my @res;
    $res[0] = "$h{name}" or die("name required");
    $res[0] .= "=$h{value}";
    foreach (qw(domain path expires max_age)) {
        my $f = $_;
Yadd's avatar
Yadd committed
452
453
        $f =~ s/_/-/g;
        push @res, "$f=$h{$_}" if ( $h{$_} );
Yadd's avatar
Yadd committed
454
455
    }
    return join( '; ', @res );
Yadd's avatar
Yadd committed
456
457
}

458
sub _dump {
Yadd's avatar
Yadd committed
459
    my ( $self, $variable ) = @_;
460
461
462
463
464
465
    require Data::Dumper;
    $Data::Dumper::Indent = 0;
    $self->lmLog( "Dump: " . Data::Dumper::Dumper($variable), 'debug' );
    return;
}

Yadd's avatar
Yadd committed
466
1;