Run.pm 27.1 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
3
##@class Lemonldap::NG::Portal::Main::Run
# Serve request part of Lemonldap::NG portal
#
Yadd's avatar
Yadd committed
4
5
6
7
8
# Parts of this file:
#  - response handler
#  - main entry points
#  - running methods
#  - utilities
Yadd's avatar
Yadd committed
9
#
Yadd's avatar
Yadd committed
10
11
package Lemonldap::NG::Portal::Main::Run;

Yadd's avatar
Yadd committed
12
our $VERSION = '2.0.1';
Yadd's avatar
Yadd committed
13

Yadd's avatar
Yadd committed
14
package Lemonldap::NG::Portal::Main;
Yadd's avatar
Yadd committed
15

Yadd's avatar
Yadd committed
16
use strict;
Yadd's avatar
Yadd committed
17
use URI::Escape;
Yadd's avatar
Yadd committed
18

Yadd's avatar
Yadd committed
19
# List constants
Yadd's avatar
Yadd committed
20
sub authProcess { qw(extractFormInfo getUser authenticate) }
Yadd's avatar
Yadd committed
21

Yadd's avatar
Yadd committed
22
sub sessionData {
Yadd's avatar
Yadd committed
23
    qw(setAuthSessionInfo setSessionInfo setMacros setGroups setPersistentSessionInfo
Yadd's avatar
Yadd committed
24
      setLocalGroups store secondFactor);
25
26
27
28
}

sub validSession {
    qw(storeHistory buildCookie);
Yadd's avatar
Yadd committed
29
30
31
32
33
34
35
36
}

# RESPONSE HANDLER
# ----------------
#
# - replace Lemonldap::NG::Common::PSGI::Request request by
#   Lemonldap::NG::Portal::Main::Request
# - launch Lemonldap::NG::Common::PSGI::Request::handler()
Yadd's avatar
Yadd committed
37
sub handler {
Yadd's avatar
Yadd committed
38
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
39

Yadd's avatar
Yadd committed
40
    bless $req, 'Lemonldap::NG::Portal::Main::Request';
Yadd's avatar
Yadd committed
41
    $req->init( $self->conf );
Yadd's avatar
Yadd committed
42
    my $sp = 0;
Yadd's avatar
Yadd committed
43
44
45

    # Restore pdata
    if ( my $v = $req->cookies->{ $self->conf->{cookieName} . 'pdata' } ) {
Yadd's avatar
Yadd committed
46
        $sp = 1;
Yadd's avatar
Yadd committed
47
        eval { $req->pdata( JSON::from_json( uri_unescape($v) ) ); };
Yadd's avatar
Yadd committed
48
49
50
51
52
53
54
55
        if ($@) {
            $self->logger->error("Bad JSON content in cookie pdata");
            $req->pdata( {} );
        }
    }
    my $res = $self->Lemonldap::NG::Common::PSGI::Router::handler($req);

    # Save pdata
Yadd's avatar
Yadd committed
56
57
58
    if ( $sp or %{ $req->pdata } ) {
        my %v = (
            name => $self->conf->{cookieName} . 'pdata',
Yadd's avatar
Yadd committed
59
60
            (
                %{ $req->pdata }
Yadd's avatar
Yadd committed
61
                ? ( value => uri_escape( JSON::to_json( $req->pdata ) ) )
Yadd's avatar
Yadd committed
62
63
                : (
                    value   => '',
64
65
                    expires => 'Wed, 21 Oct 2015 00:00:00 GMT'
                )
Yadd's avatar
Yadd committed
66
67
68
69
            )
        );
        push @{ $res->[1] }, 'Set-Cookie', $self->cookie(%v);
    }
Yadd's avatar
Yadd committed
70
    return $res;
Yadd's avatar
Yadd committed
71
72
}

Yadd's avatar
Yadd committed
73
74
75
76
# MAIN ENTRY POINTS (declared in Lemonldap::NG::Portal::Main::Init)
# -----------------
#
# Entry points:
Yadd's avatar
Yadd committed
77
#  - "/ping": - authenticated() for already authenticated users
Yadd's avatar
Yadd committed
78
79
80
81
#             - pleaseAuth() for others
#  - "/":     - login() ~first access
#             - postLogin(), same for POST requests
#             - authenticatedRequest() for authenticated users
Yadd's avatar
Yadd committed
82
83
84
85
86
87
88
89
90
91
92
93
94

sub authenticated {
    my ( $self, $req ) = @_;
    return $self->sendJSONresponse( $req, { status => 1 } );
}

sub pleaseAuth {
    my ( $self, $req ) = @_;
    return $self->sendJSONresponse( $req, { status => 0 } );
}

sub login {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
95
    return $self->do(
Yadd's avatar
Yadd committed
96
        $req,
Yadd's avatar
Yadd committed
97
98
        [
            'controlUrl',        @{ $self->beforeAuth },
99
100
101
            $self->authProcess,  @{ $self->betweenAuthAndData },
            $self->sessionData,  @{ $self->afterData },
            $self->validSession, @{ $self->endAuth },
Yadd's avatar
Yadd committed
102
        ]
Yadd's avatar
Yadd committed
103
104
105
106
107
    );
}

sub postLogin {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
108
    return $self->do(
Yadd's avatar
Yadd committed
109
        $req,
Yadd's avatar
Yadd committed
110
111
        [
            'restoreArgs',                  'controlUrl',
Yadd's avatar
Yadd committed
112
            @{ $self->beforeAuth },         $self->authProcess,
Yadd's avatar
Yadd committed
113
            @{ $self->betweenAuthAndData }, $self->sessionData,
114
115
            @{ $self->afterData },          $self->validSession,
            @{ $self->endAuth },
Yadd's avatar
Yadd committed
116
        ]
Yadd's avatar
Yadd committed
117
118
119
120
    );
}

sub authenticatedRequest {
Yadd's avatar
Yadd committed
121
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
122
123
    return $self->do(
        $req,
Yadd's avatar
Yadd committed
124
125
        [
            'importHandlerData', 'controlUrl',
Yadd's avatar
Yadd committed
126
            'checkLogout',       @{ $self->forAuthUser }
Yadd's avatar
Yadd committed
127
128
        ]
    );
Yadd's avatar
Yadd committed
129
130
}

Yadd's avatar
Yadd committed
131
132
sub postAuthenticatedRequest {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
133
134
    return $self->do(
        $req,
Yadd's avatar
Yadd committed
135
136
        [
            'importHandlerData', 'restoreArgs',
Yadd's avatar
Yadd committed
137
            'controlUrl',        'checkLogout',
Yadd's avatar
Yadd committed
138
            @{ $self->forAuthUser }
Yadd's avatar
Yadd committed
139
140
        ]
    );
Yadd's avatar
Yadd committed
141
142
}

Yadd's avatar
Yadd committed
143
144
145
sub refresh {
    my ( $self, $req ) = @_;
    $req->mustRedirect(1);
Yadd's avatar
Yadd committed
146
147
148
    my %data = %{ $req->userData };
    $req->user( $data{ $self->conf->{whatToTrace} } );
    $req->id( $data{_session_id} );
Yadd's avatar
Yadd committed
149
    $self->userLogger->notice( 'Refresh request for ' . $req->user );
Yadd's avatar
Yadd committed
150
151
    foreach ( keys %data ) {
        delete $data{$_} unless ( /^_/ or /^(?:startTime)$/ );
Yadd's avatar
Yadd committed
152
    }
Yadd's avatar
Yadd committed
153
    $req->steps(
Yadd's avatar
Yadd committed
154
155
        [
            'getUser',
Yadd's avatar
Yadd committed
156
            @{ $self->betweenAuthAndData },
Yadd's avatar
Yadd committed
157
158
159
160
161
162
            'setAuthSessionInfo',
            'setSessionInfo',
            'setMacros',
            'setGroups',
            'setLocalGroups',
            sub {
Yadd's avatar
Yadd committed
163
                $req->sessionInfo->{$_} = $data{$_} foreach ( keys %data );
Yadd's avatar
Yadd committed
164
165
166
167
168
                return PE_OK;
            },
            'store',
        ]
    );
Yadd's avatar
Yadd committed
169
170
171
    my $res = $req->error( $self->process($req) );
    if ($res) {
        $req->info(
172
            $self->loadTemplate(
Yadd's avatar
Yadd committed
173
                'simpleInfo', params => { trspan => 'rightsReloadNeedsLogout' }
174
            )
Yadd's avatar
Yadd committed
175
        );
Yadd's avatar
Yadd committed
176
        $req->urldc( $self->conf->{portal} );
Yadd's avatar
Yadd committed
177
        return $self->do( $req, [ sub { PE_INFO } ] );
Yadd's avatar
Yadd committed
178
    }
Yadd's avatar
Yadd committed
179
    return $self->do( $req, [ sub { PE_OK } ] );
Yadd's avatar
Yadd committed
180
181
}

Yadd's avatar
Yadd committed
182
183
sub logout {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
184
185
    return $self->do(
        $req,
Yadd's avatar
Yadd committed
186
187
        [
            'controlUrl', @{ $self->beforeLogout },
Yadd's avatar
Yadd committed
188
189
190
            'authLogout', 'deleteSession'
        ]
    );
Yadd's avatar
Yadd committed
191
192
}

Yadd's avatar
Yadd committed
193
194
195
# RUNNING METHODS
# ---------------

Yadd's avatar
Yadd committed
196
sub do {
Yadd's avatar
Yadd committed
197
    my ( $self, $req, $steps ) = @_;
Yadd's avatar
Yadd committed
198
    $req->steps($steps);
Yadd's avatar
Yadd committed
199
    $req->data->{activeTimer} = $self->conf->{activeTimer};
Yadd's avatar
Yadd committed
200
    my $err = $req->error( $self->process($req) );
Yadd's avatar
Yadd committed
201

Yadd's avatar
Yadd committed
202
    # Update status
Yadd's avatar
Yadd committed
203
    if ( my $p = $self->HANDLER->tsv->{statusPipe} ) {
Yadd's avatar
Yadd committed
204
205
206
        $p->print( ( $req->user ? $req->user : $req->address ) . ' => '
              . $req->uri
              . " $err\n" );
Yadd's avatar
Yadd committed
207
    }
Yadd's avatar
Yadd committed
208
209

    # Update history
210
211
212
    if ( $err == PE_SENDRESPONSE ) {
        return $req->response;
    }
Yadd's avatar
Yadd committed
213
    if ( !$self->conf->{noAjaxHook} and $req->wantJSON ) {
Yadd's avatar
Yadd committed
214
        $self->logger->debug('Processing to JSON response');
Yadd's avatar
Yadd committed
215
        if ( ( $err > 0 and !$req->id ) or $err eq PE_SESSIONNOTGRANTED ) {
Yadd's avatar
Yadd committed
216
217
            return [
                401,
218
                [ 'WWW-Authenticate' => "SSO " . $self->conf->{portal} ],
Yadd's avatar
Typo    
Yadd committed
219
                [qq'{"result":0,"error":$err}']
Yadd's avatar
Yadd committed
220
            ];
Yadd's avatar
Yadd committed
221
        }
222
        elsif ( $err > 0 and $err != PE_PASSWORD_OK ) {
Yadd's avatar
Yadd committed
223
224
225
226
227
228
            return $self->sendJSONresponse(
                $req,
                { result => 0, error => $err },
                code => 400
            );
        }
Yadd's avatar
Yadd committed
229
        else {
Yadd's avatar
Yadd committed
230
231
            return $self->sendJSONresponse(
                $req,
Yadd's avatar
Yadd committed
232
233
                {
                    result => 1,
Yadd's avatar
Yadd committed
234
235
236
                    code   => $err
                }
            );
Yadd's avatar
Yadd committed
237
238
239
        }
    }
    else {
Yadd's avatar
Yadd committed
240
241
        if (
                $err
Yadd's avatar
Yadd committed
242
243
244
245
            and $err != PE_LOGOUT_OK
            and (
                $err != PE_REDIRECT
                or (    $err == PE_REDIRECT
Yadd's avatar
Yadd committed
246
247
                    and $req->data->{redirectFormMethod}
                    and $req->data->{redirectFormMethod} eq 'post' )
Yadd's avatar
Yadd committed
248
                or $req->info
Yadd's avatar
Yadd committed
249
            )
Yadd's avatar
Yadd committed
250
          )
Yadd's avatar
Yadd committed
251
        {
252
            my ( $tpl, $prms ) = $self->display($req);
Yadd's avatar
Yadd committed
253
            $self->logger->debug("Calling sendHtml with template $tpl");
254
            return $self->sendHtml( $req, $tpl, params => $prms );
Yadd's avatar
Yadd committed
255
256
        }
        else {
Yadd's avatar
Yadd committed
257
            $self->logger->debug('Calling autoredirect');
Yadd's avatar
Yadd committed
258
259
260
261
262
            return $self->autoRedirect($req);
        }
    }
}

Yadd's avatar
Yadd committed
263
264
265
266
267
# Utilities
# ---------

sub getModule {
    my ( $self, $req, $type ) = @_;
Yadd's avatar
Yadd committed
268
269
    if (
        my $mod = {
Yadd's avatar
Yadd committed
270
271
272
273
            auth     => '_authentication',
            user     => '_userDB',
            password => '_passwordDB'
        }->{$type}
Yadd's avatar
Yadd committed
274
      )
Yadd's avatar
Yadd committed
275
    {
Yadd's avatar
Yadd committed
276
277
        if ( my $sub = $self->$mod->can('name') ) {
            return $sub->( $self->$mod, $req, $type );
Yadd's avatar
Yadd committed
278
279
        }
        else {
Yadd's avatar
Yadd committed
280
            my $s = ref( $self->$mod );
Yadd's avatar
Yadd committed
281
282
            $s =~
s/^Lemonldap::NG::Portal::(?:(?:Issuer|UserDB|Auth|Password)::)?//;
Yadd's avatar
Yadd committed
283
            return $s;
Yadd's avatar
Yadd committed
284
285
286
287
288
289
290
        }
    }
    elsif ( $type eq 'issuer' ) {
        return $req->{_activeIssuerDB};
    }
    else {
        die "Unknown type $type";
Yadd's avatar
Yadd committed
291
    }
Yadd's avatar
Yadd committed
292
293
}

Yadd's avatar
Yadd committed
294
295
296
297
sub autoRedirect {
    my ( $self, $req ) = @_;

    # Set redirection URL if needed
Yadd's avatar
Yadd committed
298
    $req->{urldc} ||= $self->conf->{portal}
Yadd's avatar
Yadd committed
299
      if ( $req->mustRedirect and not( $req->info ) );
Yadd's avatar
Yadd committed
300
301

    # Redirection should be made if urldc defined
302
    if ( $req->{urldc} ) {
303
        $self->logger->debug("Building redirection to $req->{urldc}");
304
        if ( $self->_jsRedirect->( $req, $req->sessionInfo ) ) {
Yadd's avatar
Yadd committed
305
            $req->error(PE_REDIRECT);
Yadd's avatar
Yadd committed
306
            $req->data->{redirectFormMethod} = "get";
Yadd's avatar
Yadd committed
307
308
        }
        else {
Yadd's avatar
Yadd committed
309
310
            return [ 302,
                [ Location => $req->{urldc}, @{ $req->respHeaders } ], [] ];
Yadd's avatar
Yadd committed
311
        }
Yadd's avatar
Yadd committed
312
    }
Yadd's avatar
Yadd committed
313
    my ( $tpl, $prms ) = $self->display($req);
Yadd's avatar
Yadd committed
314
    $self->logger->debug("Calling sendHtml with template $tpl");
Yadd's avatar
Yadd committed
315
    return $self->sendHtml( $req, $tpl, params => $prms );
Yadd's avatar
Yadd committed
316
317
}

Yadd's avatar
Yadd committed
318
# Try to recover the session corresponding to id and return session data.
Yadd's avatar
Yadd committed
319
# If $id is set to undef or if $args{force} is true, return a new session.
Yadd's avatar
Yadd committed
320
sub getApacheSession {
Yadd's avatar
Yadd committed
321
322
    my ( $self, $id, %args ) = @_;
    $args{kind} ||= "SSO";
Yadd's avatar
Yadd committed
323
    if ($id) {
Yadd's avatar
Yadd committed
324
        $self->logger->debug("Try to get $args{kind} session $id");
Yadd's avatar
Yadd committed
325
326
    }
    else {
Yadd's avatar
Yadd committed
327
        $self->logger->debug("Try to get a new $args{kind} session");
Yadd's avatar
Yadd committed
328
329
    }

Yadd's avatar
Yadd committed
330
    my $as = Lemonldap::NG::Common::Session->new(
Yadd's avatar
Yadd committed
331
332
        {
            storageModule        => $self->conf->{globalStorage},
Yadd's avatar
Yadd committed
333
334
335
336
            storageModuleOptions => $self->conf->{globalStorageOptions},
            cacheModule          => $self->conf->{localSessionStorage},
            cacheModuleOptions   => $self->conf->{localSessionStorageOptions},
            id                   => $id,
Yadd's avatar
Yadd committed
337
338
            force                => $args{force},
            kind                 => $args{kind},
339
            ( $args{info} ? ( info => $args{info} ) : () ),
Yadd's avatar
Yadd committed
340
341
342
        }
    );

Yadd's avatar
Yadd committed
343
    if ( my $err = $as->error ) {
344
345
        $self->lmLog(
            $err,
Yadd's avatar
Yadd committed
346
347
            (
                $err =~ /(?:Object does not exist|Invalid session ID)/
348
349
350
351
                ? 'notice'
                : 'error'
            )
        );
Yadd's avatar
Yadd committed
352
353
354
        return;
    }

Yadd's avatar
Yadd committed
355
    if ( $id and !$args{force} and !$as->data ) {
Yadd's avatar
Yadd committed
356
        $self->logger->debug("Session $args{kind} $id not found");
Yadd's avatar
Yadd committed
357
358
        return;
    }
359
360
361
    $self->logger->debug("Get session $id from Portal::Main::Run") if ($id);
    $self->logger->debug(
        "Check session validity  -> " . $self->conf->{timeoutActivity} . "s" )
Yadd's avatar
Yadd committed
362
      if ( $self->conf->{timeoutActivity} );
Yadd's avatar
Yadd committed
363
    my $now = time;
Yadd's avatar
Yadd committed
364
365
    if (
            $id
Yadd's avatar
Yadd committed
366
        and defined $as->data->{_utime}
Yadd's avatar
Yadd committed
367
        and (
368
            ( ( $now - $as->data->{_utime} ) > $self->conf->{timeout} )
Yadd's avatar
Yadd committed
369
370
            or (
                    $self->conf->{timeoutActivity}
Yadd's avatar
Yadd committed
371
                and $as->data->{_lastSeen}
Yadd's avatar
Yadd committed
372
373
                and ( ( $now - $as->data->{_lastSeen} ) >
                    $self->conf->{timeoutActivity} )
374
375
            )
        )
Yadd's avatar
Yadd committed
376
      )
Yadd's avatar
Yadd committed
377
    {
Yadd's avatar
Yadd committed
378
        $self->logger->debug("Session $args{kind} $id expired");
Yadd's avatar
Yadd committed
379
380
381
        return;
    }

Yadd's avatar
Yadd committed
382
    $self->logger->debug( "Return $args{kind} session " . $as->id );
Yadd's avatar
Yadd committed
383

Yadd's avatar
Yadd committed
384
385
386
    return $as;
}

Yadd's avatar
Yadd committed
387
# Try to recover the persistent session corresponding to uid and return session data.
Yadd's avatar
Yadd committed
388
sub getPersistentSession {
389
    my ( $self, $uid, $info ) = @_;
Yadd's avatar
Yadd committed
390
391
392
393
394
395

    return unless defined $uid;

    # Compute persistent identifier
    my $pid = $self->_md5hash($uid);

396
397
    $info->{_session_uid} = $uid;

Yadd's avatar
Yadd committed
398
    my $ps = Lemonldap::NG::Common::Session->new(
Yadd's avatar
Yadd committed
399
400
        {
            storageModule        => $self->conf->{persistentStorage},
Yadd's avatar
Yadd committed
401
            storageModuleOptions => $self->conf->{persistentStorageOptions},
Yadd's avatar
Yadd committed
402
403
404
            id                   => $pid,
            force                => 1,
            kind                 => "Persistent",
405
            ( $info ? ( info => $info ) : () ),
Yadd's avatar
Yadd committed
406
407
408
409
        }
    );

    if ( $ps->error ) {
Yadd's avatar
Yadd committed
410
        $self->logger->debug( $ps->error );
Yadd's avatar
Yadd committed
411
    }
412
    else {
Yadd's avatar
Yadd committed
413

414
415
416
417
        # Set _session_uid if not already present
        unless ( defined $ps->data->{_session_uid} ) {
            $ps->update( { _session_uid => $uid } );
        }
Yadd's avatar
Yadd committed
418

419
420
421
422
        # Set _utime if not already present
        unless ( defined $ps->data->{_utime} ) {
            $ps->update( { _utime => time } );
        }
Yadd's avatar
Yadd committed
423
424
425
426
427
    }

    return $ps;
}

Yadd's avatar
Yadd committed
428
429
430
431
432
433
434
435
436
437
438
439
# Update persistent session.
# Call updateSession() and store %$infos in a persistent session.
# Note that if the session does not exists, it will be created.
# @param infos hash reference of information to update
# @param uid optional Unhashed persistent session ID
# @param id optional SSO session ID
# @return nothing
sub updatePersistentSession {
    my ( $self, $req, $infos, $uid, $id ) = @_;

    # Return if no infos to update
    return () unless ( ref $infos eq 'HASH' and %$infos );
Yadd's avatar
Yadd committed
440
    $uid ||= $req->{sessionInfo}->{ $self->conf->{whatToTrace} }
Yadd's avatar
Yadd committed
441
      || $req->userData->{ $self->conf->{whatToTrace} };
442
    $self->logger->debug("Found 'whatToTrace' -> $uid");
Yadd's avatar
Yadd committed
443
    unless ($uid) {
Yadd's avatar
Yadd committed
444
        $self->logger->debug('No uid found, skipping updatePersistentSession');
Yadd's avatar
Yadd committed
445
446
        return ();
    }
Yadd's avatar
Yadd committed
447
    $self->logger->debug("Update $uid persistent session");
Yadd's avatar
Yadd committed
448

Yadd's avatar
Yadd committed
449
450
451
    # Update current session
    $self->updateSession( $req, $infos, $id );

452
    my $persistentSession = $self->getPersistentSession( $uid, $infos );
Yadd's avatar
Yadd committed
453
454

    if ( $persistentSession->error ) {
Yadd's avatar
Yadd committed
455
456
457
        $self->logger->error(
            "Cannot update persistent session " . $self->_md5hash($uid) );
        $self->logger->error( $persistentSession->error );
Yadd's avatar
Yadd committed
458
459
460
461
462
    }
}

# Update session stored.
# If no id is given, try to get it from cookie.
Yadd's avatar
Yadd committed
463
# If the session is available, update data with $info.
Yadd's avatar
Yadd committed
464
465
466
467
468
469
470
471
472
473
474
475
# Note that outdated session data may remain some time on
# server local cache, if there are several LL::NG servers.
# @param infos hash reference of information to update
# @param id Session ID
# @return nothing
sub updateSession {
    my ( $self, $req, $infos, $id ) = @_;

    # Return if no infos to update
    return () unless ( ref $infos eq 'HASH' and %$infos );

    # Recover session ID unless given
Yadd's avatar
Yadd committed
476
    $id ||= $req->{id} || $req->userData->{_session_id};
Yadd's avatar
Yadd committed
477
478
479
480
481

    if ($id) {

        # Update sessionInfo data
        ## sessionInfo updated if $id defined : quite strange !!
Yadd's avatar
Yadd committed
482
        ## See https://gitlab.ow2.org/lemonldap-ng/lemonldap-ng/issues/430
Yadd's avatar
Yadd committed
483
        foreach ( keys %$infos ) {
Yadd's avatar
Yadd committed
484
485
            $self->logger->debug(
                "Update sessionInfo $_ with " . $infos->{$_} );
Yadd's avatar
Yadd committed
486
487
            $req->{sessionInfo}->{$_} = $self->HANDLER->data->{$_} =
              $infos->{$_};
Yadd's avatar
Yadd committed
488
489
        }

490
491
        # Update session in global storage with _updateTime
        $infos->{_updateTime} = strftime( "%Y%m%d%H%M%S", localtime() );
Yadd's avatar
Yadd committed
492
493
        if ( my $apacheSession =
            $self->getApacheSession( $id, info => $infos ) )
494
        {
Yadd's avatar
Yadd committed
495
            if ( $apacheSession->error ) {
Yadd's avatar
Yadd committed
496
497
                $self->logger->error("Cannot update session $id");
                $self->logger->error( $apacheSession->error );
Yadd's avatar
Yadd committed
498
499
500
501
502
            }
        }
    }
}

Yadd's avatar
Yadd committed
503
504
505
506
507
508
509
510
511
# Delete an existing session. If "securedCookie" is set to 2, the http session
# will also be removed.
# @param h tied Apache::Session object
# @param preserveCookie do not delete cookie
# @return True if session has been deleted
sub _deleteSession {
    my ( $self, $req, $session, $preserveCookie ) = @_;

    # Invalidate http cookie and session, if set
Yadd's avatar
Typo    
Yadd committed
512
    if ( $self->conf->{securedCookie} >= 2 ) {
Yadd's avatar
Yadd committed
513
514

        # Try to find a linked http session (securedCookie == 2)
Yadd's avatar
Typo    
Yadd committed
515
        if ( $self->conf->{securedCookie} == 2
516
517
            and my $id2 = $session->data->{_httpSession} )
        {
Yadd's avatar
Yadd committed
518
            if ( my $session2 = $self->getApacheSession($id2) ) {
Yadd's avatar
Yadd committed
519
520
                $session2->remove;
                if ( $session2->error ) {
Yadd's avatar
Yadd committed
521
522
523
                    $self->logger->debug(
                        "Unable to remove linked session $id2");
                    $self->logger->debug( $session2->error );
Yadd's avatar
Yadd committed
524
525
526
527
528
                }
            }
        }

        # Create an obsolete cookie to remove it
Yadd's avatar
Yadd committed
529
530
531
532
533
534
        $req->addCookie(
            $self->cookie(
                name    => $self->conf->{cookieName} . 'http',
                value   => 0,
                domain  => $self->conf->{domain},
                secure  => 0,
Yadd's avatar
Yadd committed
535
                expires => 'Wed, 21 Oct 2015 00:00:00 GMT'
Yadd's avatar
Yadd committed
536
537
            )
        ) unless ($preserveCookie);
Yadd's avatar
Yadd committed
538
539
    }

540
    HANDLER->localUnlog( $req, $session->id );
Yadd's avatar
Yadd committed
541
542
543
    $session->remove;

    # Create an obsolete cookie to remove it
Yadd's avatar
Yadd committed
544
545
546
547
548
549
    $req->addCookie(
        $self->cookie(
            name    => $self->conf->{cookieName},
            value   => 0,
            domain  => $self->conf->{domain},
            secure  => 0,
Yadd's avatar
Yadd committed
550
            expires => 'Wed, 21 Oct 2015 00:00:00 GMT'
Yadd's avatar
Yadd committed
551
552
        )
    ) unless ($preserveCookie);
Yadd's avatar
Yadd committed
553
554
555

    # Log
    my $user = $req->{sessionInfo}->{ $self->conf->{whatToTrace} };
556
    $self->userLogger->notice("User $user has been disconnected") if $user;
Yadd's avatar
Yadd committed
557
558
559
560

    return $session->error ? 0 : 1;
}

Yadd's avatar
Yadd committed
561
562
563
564
565
566
# Return md5(s)
sub _md5hash {
    my ( $self, $s ) = @_;
    return substr( Digest::MD5::md5_hex($s), 0, 32 );
}

Yadd's avatar
Yadd committed
567
568
569
570
# Check if an URL's domain name is declared in LL::NG config or is declared as
# trusted domain
sub isTrustedUrl {
    my ( $self, $url ) = @_;
Yadd's avatar
Yadd committed
571
    return $url =~ $self->trustedDomainsRe ? 1 : 0;
Yadd's avatar
Yadd committed
572
573
}

Yadd's avatar
Yadd committed
574
575
sub stamp {
    my $self = shift;
Yadd's avatar
Yadd committed
576
577
578
579
    my $res =
        $self->conf->{cipher}
      ? $self->conf->{cipher}->encrypt( time() )
      : 1;
Yadd's avatar
Yadd committed
580
581
    $res =~ s/\+/%2B/g;
    return $res;
Yadd's avatar
Yadd committed
582
583
}

Yadd's avatar
Yadd committed
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
# Transfer POST data with auto submit
# @return void
sub autoPost {
    my ( $self, $req ) = @_;

    # Get URL and Form fields
    $req->{urldc} = $req->postUrl;
    my $formFields = $req->postFields;

    $self->clearHiddenFormValue($req);
    foreach ( keys %$formFields ) {
        $self->setHiddenFormValue( $req, $_, $formFields->{$_}, "", 0 );
    }

    # Display info before redirecting
    if ( $req->info() ) {
        $req->{infoFormMethod} = $req->param('method') || "post";
        return PE_INFO;
    }

Yadd's avatar
Yadd committed
604
    $req->data->{redirectFormMethod} = "post";
Yadd's avatar
Yadd committed
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
    return PE_REDIRECT;
}

# Add element into $self->{portalHiddenFormValues}, those values could be
# used to hide values into HTML form.
# @param fieldname The field name which will contain the correponding value
# @param value The associated value
# @param prefix Prefix of the field key
# @param base64 Encode value in base64
# @return nothing
sub setHiddenFormValue {
    my ( $self, $req, $key, $val, $prefix, $base64 ) = @_;

    # Default values
    $prefix = "lmhidden_" unless defined $prefix;
    $base64 = 1           unless defined $base64;
Yadd's avatar
Yadd committed
621
    $val    = ''          unless defined $val;
Yadd's avatar
Yadd committed
622
623

    # Store value
624
    if ( defined $val or !( $val & ~$val ) ) {
Yadd's avatar
Yadd committed
625
        $key = $prefix . $key;
Yadd's avatar
Yadd committed
626
627

        #$val =~ s/\+/%2B/g;
Yadd's avatar
Yadd committed
628
        $req->{portalHiddenFormValues}->{$key} = $val;
Yadd's avatar
Yadd committed
629
        $self->logger->debug("Store $val in hidden key $key");
Yadd's avatar
Yadd committed
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
    }
}

## @method public void getHiddenFormValue(string fieldname, string prefix, boolean base64)
# Get value into $self->{portalHiddenFormValues}.
# @param fieldname The existing field name which contains a value
# @param prefix Prefix of the field key
# @param base64 Decode value from base64
# @return string The associated value
sub getHiddenFormValue {
    my ( $self, $req, $key, $prefix, $base64 ) = @_;

    # Default values
    $prefix = "lmhidden_" unless defined $prefix;
    $base64 = 1           unless defined $base64;

    $key = $prefix . $key;

    # Get value
649
650
    my $val = $req->param($key);
    if ( defined $val ) {
Yadd's avatar
Yadd committed
651
        $val = decode_base64($val) if $base64;
Yadd's avatar
Yadd committed
652
        $self->logger->debug("Hidden value $val found for key $key");
653
        return $val;
Yadd's avatar
Yadd committed
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
    }

    # No value found
    return undef;
}

## @method protected void clearHiddenFormValue(arrayref keys)
# Clear values form stored hidden fields
# Delete all keys if no keys provided
# @param keys Array reference of keys
# @return nothing
sub clearHiddenFormValue {
    my ( $self, $req, $keys ) = @_;

    unless ( defined $keys ) {
        delete $req->{portalHiddenFormValues};
Yadd's avatar
Yadd committed
670
        $self->logger->debug("Delete all hidden values");
Yadd's avatar
Yadd committed
671
672
673
674
    }
    else {
        foreach (@$keys) {
            delete $req->{portalHiddenFormValues}->{$_};
Yadd's avatar
Yadd committed
675
            $self->logger->debug("Delete hidden value for key $_");
Yadd's avatar
Yadd committed
676
677
678
679
680
681
        }
    }

    return;
}

Yadd's avatar
Yadd committed
682
683
684
685
686
687
688
689
690
# Get the first value of a multivaluated session value
sub getFirstValue {
    my ( $self, $value ) = @_;

    my @values = split /$self->{conf}->{multiValuesSeparator}/, $value;

    return $values[0];
}

Yadd's avatar
Yadd committed
691
sub info {
Yadd's avatar
Yadd committed
692
693
    my ( $self, $req, $info ) = @_;
    return $req->info($info);
Yadd's avatar
Yadd committed
694
695
}

Yadd's avatar
Yadd committed
696
697
698
699
sub fullUrl {
    my ( $self, $req ) = @_;
    my $pHost = $self->conf->{portal};
    $pHost =~ s#^(https?://[^/]+)(?:/.*)?$#$1#;
Yadd's avatar
Yadd committed
700
    return $pHost . $req->env->{REQUEST_URI};
Yadd's avatar
Yadd committed
701
702
}

Yadd's avatar
Yadd committed
703
704
705
706
707
708
709
sub cookie {
    my ( $self, %h ) = @_;
    my @res;
    $res[0] = "$h{name}" or die("name required");
    $res[0] .= "=$h{value}";
    $h{path} ||= '/';
    $h{HttpOnly} //= $self->conf->{httpOnly};
Yadd's avatar
Yadd committed
710
    $h{max_age}  //= $self->conf->{cookieExpiration}
Yadd's avatar
Yadd committed
711
      if ( $self->conf->{cookieExpiration} );
Yadd's avatar
Yadd committed
712
713
714
715
716
    foreach (qw(domain path expires max_age HttpOnly)) {
        my $f = $_;
        $f =~ s/_/-/g;
        push @res, "$f=$h{$_}" if ( $h{$_} );
    }
Yadd's avatar
Yadd committed
717
    push @res, 'secure' if ( $h{secure} );
Yadd's avatar
Yadd committed
718
719
720
721
722
723
    return join( '; ', @res );
}

sub _dump {
    my ( $self, $variable ) = @_;
    require Data::Dumper;
Yadd's avatar
Yadd committed
724
725
    $Data::Dumper::Indent  = 0;
    $Data::Dumper::Useperl = 1;
Yadd's avatar
Yadd committed
726
    $self->logger->debug( "Dump: " . Data::Dumper::Dumper($variable) );
Yadd's avatar
Yadd committed
727
728
729
    return;
}

730
731
sub sendHtml {
    my ( $self, $req, $template, %args ) = @_;
Yadd's avatar
Yadd committed
732
    $args{params}->{TROVER} = $self->trOver;
Yadd's avatar
Yadd committed
733
734
    my $res = $self->SUPER::sendHtml( $req, $template, %args );
    push @{ $res->[1] },
Yadd's avatar
Yadd committed
735
736
      'X-XSS-Protection'       => '1; mode=block',
      'X-Content-Type-Options' => 'nosniff';
Yadd's avatar
Yadd committed
737

738
    # Set authorized URL for POST
Yadd's avatar
Yadd committed
739
    my $csp = $self->csp . "form-action " . $self->conf->{cspFormAction};
Yadd's avatar
Yadd committed
740
    if ( my $url = $req->urldc ) {
Yadd's avatar
Yadd committed
741
        $self->logger->debug("Required urldc : $url");
742
        $url =~ s#(https?://[^/]+).*#$1#;
743
        $self->logger->debug("Set CSP form-action with urldc : $url");
Yadd's avatar
Yadd committed
744
        $csp .= " $url";
Yadd's avatar
Yadd committed
745
    }
Christophe Maudoux's avatar
Christophe Maudoux committed
746
    my $url = $args{params}->{URL};
Yadd's avatar
Yadd committed
747
748
749
    if ( defined $url ) {
        $self->logger->debug("Required Params URL : $url");
        if ( $url =~ s#(https?://[^/]+).*#$1# ) {
Yadd's avatar
Yadd committed
750
            $self->logger->debug("Set CSP form-action with Params URL : $url");
Yadd's avatar
Yadd committed
751
752
            $csp .= " $url";
        }
Yadd's avatar
Yadd committed
753
    }
754
    if ( defined $req->{cspFormAction} ) {
Yadd's avatar
Yadd committed
755
756
        $self->logger->debug(
            "Set CSP form-action with request URL: " . $req->{cspFormAction} );
757
758
        $csp .= " " . $req->{cspFormAction};
    }
759
760
761
762
763
764
765
766
767
768
769

    # Set SAML Discovery Protocol in form-action
    # See https://github.com/w3c/webappsec-csp/issues/8
    if ( $self->conf->{samlDiscoveryProtocolActivation}
        and defined $self->conf->{samlDiscoveryProtocolURL} )
    {
        $self->logger->debug(
            "Add SAML Discovery Protocol URL in CSP form-action");

        $csp .= " " . $self->conf->{samlDiscoveryProtocolURL};
    }
Christophe Maudoux's avatar
Christophe Maudoux committed
770
    $csp .= ';';
Yadd's avatar
Yadd committed
771
772

    # Deny using portal in frame except if it is required
Yadd's avatar
Yadd committed
773
    unless ( $req->frame or $self->conf->{portalAntiFrame} == 0 ) {
Yadd's avatar
Yadd committed
774
        push @{ $res->[1] }, 'X-Frame-Options' => 'DENY';
Yadd's avatar
Yadd committed
775
776
777
778
779
780
781
        $csp .= "frame-ancestors 'none';";
    }

    # Check if frames need to be embedded
    my @url;
    if ( $req->info ) {
        @url = map { s#https?://([^/]+).*#$1#; $_ }
Yadd's avatar
Yadd committed
782
          ( $req->info =~ /<iframe.*?src="(.*?)"/sg );
Yadd's avatar
Yadd committed
783
784
785
    }
    if (@url) {
        $csp .= join( ' ', 'child-src', @url ) . ';';
786
787
    }

Yadd's avatar
Yadd committed
788
    # Set CSP header
Yadd's avatar
Yadd committed
789
    push @{ $res->[1] }, 'Content-Security-Policy' => $csp;
790
    $self->logger->debug("Apply following CSP : $csp");
Yadd's avatar
Yadd committed
791
    return $res;
792
793
}

Yadd's avatar
Yadd committed
794
795
sub sendCss {
    my ( $self, $req ) = @_;
Yadd's avatar
Yadd committed
796
797
798
799
800
801
802
    my $s =
        'html,body{background:url("'
      . $self->staticPrefix
      . '/common/backgrounds/'
      . $self->conf->{portalSkinBackground}
      . '") no-repeat center fixed;'
      . 'background-size:cover;}';
Yadd's avatar
Yadd committed
803
804
    return [
        200,
Yadd's avatar
Yadd committed
805
806
        [
            'Content-Type'   => 'text/css',
Yadd's avatar
Yadd committed
807
808
809
810
811
812
813
            'Content-Length' => length($s),
            'Cache-Control'  => 'public,max-age=3600',
        ],
        [$s]
    ];
}

814
815
816
817
818
819
820
821
sub lmError {
    my ( $self, $req ) = @_;
    my $httpError = $req->param('code');

    # Check URL
    $self->controlUrl($req);

    my %templateParams = (
822
823
        MAIN_LOGO  => $self->conf->{portalMainLogo},
        LANGS      => $self->conf->{showLanguages},
824
825
826
827
828
829
        LOGOUT_URL => $self->conf->{portal} . "?logout=1",
        URL        => $req->{urldc},
    );

    # Error code
    $templateParams{"ERROR$_"} = ( $httpError == $_ ? 1 : 0 )
Yadd's avatar
Yadd committed
830
      foreach ( 403, 404, 500, 502, 503 );
831
832
833
    return $self->sendHtml( $req, 'error', params => \%templateParams );
}

Yadd's avatar
Yadd committed
834
835
836
sub rebuildCookies {
    my ( $self, $req ) = @_;
    my @tmp;
Yadd's avatar
Yadd committed
837
    for ( my $i = 0 ; $i < @{ $req->{respHeaders} } ; $i += 2 ) {
Yadd's avatar
Yadd committed
838
        push @tmp, $req->respHeaders->[0], $req->respHeaders->[1]
Yadd's avatar
Yadd committed
839
          unless ( $req->respHeaders->[0] eq 'Set-Cookie' );
Yadd's avatar
Yadd committed
840
841
842
843
844
    }
    $req->{respHeaders} = \@tmp;
    $self->buildCookie($req);
}

845
sub tplParams {
846
847
848
849
    my ( $self, $req ) = @_;
    my %templateParams;

    my $portalPath = $self->conf->{portal};
Yadd's avatar
Yadd committed
850
851
    $portalPath =~ s#^https?://[^/]+/?#/#;
    $portalPath =~ s#[^/]+\.fcgi$##;
852
853
854
855
856
857
858
859
860
861

    for my $session_key ( keys %{ $req->{sessionInfo} } ) {
        $templateParams{ "session_" . $session_key } =
        $req->{sessionInfo}->{$session_key};
    }

    for my $env_key ( keys %{ $req->env } ) {
        $templateParams{ "env_" . $env_key } = $req->env->{$env_key};
    }

862
    return (
863
864
        SKIN       => $self->getSkin( $req ),
        PORTAL_URL => $self->conf->{portal},
Yadd's avatar
Yadd committed
865
        SKIN_PATH  => $portalPath . "skins",
866
867
868
869
        ANTIFRAME  => $self->conf->{portalAntiFrame},
        SKIN_BG    => $self->conf->{portalSkinBackground},
        ( $self->customParameters ? ( %{ $self->customParameters } ) : () ),
        %templateParams
870
    );
871
872
}

Yadd's avatar
Yadd committed
873
874
sub registerLogin {
    my ( $self, $req ) = @_;
875
    return
Yadd's avatar
Yadd committed
876
      unless ( $self->conf->{loginHistoryEnabled}
877
        and defined $req->authResult );
Yadd's avatar
Yadd committed
878
    my $history = $req->sessionInfo->{_loginHistory} ||= {};
Yadd's avatar
Yadd committed
879
880
881
882
883
884
885
    my $type = ( $req->authResult > 0 ? 'failed' : 'success' ) . 'Login';
    $history->{$type} ||= [];
    $self->logger->debug("Current login saved into $type");

    # Gather current login's parameters
    my $login = $self->_sumUpSession( $req->{sessionInfo}, 1 );
    $login->{error} = $self->error( $req->authResult )
Yadd's avatar
Yadd committed
886
      if ( $req->authResult );
Yadd's avatar
Yadd committed
887

Clément OUDOT's avatar
Clément OUDOT committed
888
    $self->logger->debug( " Current login -> " . $login->{error} )
Yadd's avatar
Yadd committed
889
      if ( $login->{error} );
890

Yadd's avatar
Yadd committed
891
892
893
894
895
    # Add current login into history
    unshift @{ $history->{$type} }, $login;

    # Forget oldest logins
    splice @{ $history->{$type} }, $self->conf->{ $type . "Number" }
Yadd's avatar
Yadd committed
896
      if ( scalar @{ $history->{$type} } > $self->conf->{ $type . "Number" } );
Yadd's avatar
Yadd committed
897
898

    # Save into persistent session
Yadd's avatar
Yadd committed
899
    $self->updatePersistentSession( $req, { _loginHistory => $history, } );
Yadd's avatar
Yadd committed
900

901
    PE_OK;
Yadd's avatar
Yadd committed
902
903
904
905
906
907
908
}

# put main session data into a hash ref
# @param hashref $session The session to sum up
# @return hashref
sub _sumUpSession {
    my ( $self, $session, $withoutUser ) = @_;
Yadd's avatar
Yadd committed
909
910
911
912
    my $res =
      $withoutUser
      ? {}
      : { user => $session->{ $self->conf->{whatToTrace} } };
Yadd's avatar
Yadd committed
913
    $res->{$_} = $session->{$_}
Yadd's avatar
Yadd committed
914
      foreach ( "_utime", "ipAddr",
Yadd's avatar
Yadd committed
915
916
917
918
        keys %{ $self->conf->{sessionDataToRemember} } );
    return $res;
}

919
920
921
922
# Temlate loader
sub loadTemplate {
    my ( $self, $name, %prm ) = @_;
    $name .= '.tpl';
Yadd's avatar
Yadd committed
923
924
925
926
    my $file =
        $self->conf->{templateDir} . '/'
      . $self->conf->{portalSkin} . '/'
      . $name;
927
    $file = $self->conf->{templateDir} . '/common/' . $name
Yadd's avatar
Yadd committed
928
      unless ( -e $file );
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
    unless ( -e $file ) {
        die "Unable to find $name in $self->conf->{templateDir}";
    }
    my $tpl = HTML::Template->new(
        filename               => $file,
        die_on_bad_params      => 0,
        die_on_missing_include => 1,
        cache                  => 1,
        global_vars            => 0,
        ( $prm{filter} ? ( filter => $prm{filter} ) : () ),
    );
    if ( $prm{params} ) {
        $tpl->param( %{ $prm{params} } );
    }
    return $tpl->output;
}

Yadd's avatar
Yadd committed
946
1;