Simple.pm 52.6 KB
Newer Older
1
##@file
Yadd's avatar
Yadd committed
2
3
# Base package for Lemonldap::NG portal

4
##@class Lemonldap::NG::Portal::Simple
Yadd's avatar
Yadd committed
5
# Base class for Lemonldap::NG portal
6
7
8
9
10
11
12
13
14
package Lemonldap::NG::Portal::Simple;

use strict;
use warnings;

use Exporter 'import';

use warnings;
use MIME::Base64;
15
use Lemonldap::NG::Common::CGI;
16
use CGI::Cookie;
17
require POSIX;
Yadd's avatar
Yadd committed
18
use Lemonldap::NG::Portal::_i18n;      #inherits
Yadd's avatar
Yadd committed
19
use Lemonldap::NG::Common::Safelib;    #link protected safe Safe object
Yadd's avatar
Yadd committed
20
21
use Lemonldap::NG::Common::Apache::Session
  ;    #link protected session Apache::Session object
22
use Safe;
23

24
# Special comments for doxygen
Yadd's avatar
Yadd committed
25
#inherits Lemonldap::NG::Portal::_SOAP
26
#inherits Lemonldap::NG::Portal::AuthApache
27
#inherits Lemonldap::NG::Portal::AuthDBI
28
29
#inherits Lemonldap::NG::Portal::AuthCAS
#inherits Lemonldap::NG::Portal::AuthLDAP
Yadd's avatar
Yadd committed
30
#inherits Lemonldap::NG::Portal::AuthRemote
31
32
#inherits Lemonldap::NG::Portal::AuthSSL
#inherits Lemonldap::NG::Portal::Menu
Yadd's avatar
Yadd committed
33
#link Lemonldap::NG::Portal::Notification protected notification
34
35
#inherits Lemonldap::NG::Portal::UserDBDBI
#inherits Lemonldap::NG::Portal::UserDBEnv
36
#inherits Lemonldap::NG::Portal::UserDBLDAP
Yadd's avatar
Yadd committed
37
#inherits Lemonldap::NG::Portal::UserDBRemote
38
#inherits Lemonldap::NG::Portal::PasswordDBDBI
Clément OUDOT's avatar
Clément OUDOT committed
39
#inherits Lemonldap::NG::Portal::PasswordDBLDAP
40
#inherits Apache::Session
Yadd's avatar
Yadd committed
41
#link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage
42

43
our $VERSION = '0.91';
44

Yadd's avatar
Yadd committed
45
46
use base qw(Lemonldap::NG::Common::CGI Exporter);
our @ISA;
47
48

# Constants
49
use constant {
Yadd's avatar
Yadd committed
50

51
    # Portal errors
Yadd's avatar
Yadd committed
52
53
    # Developers warning, do not use PE_INFO, it's reserved to autoRedirect.
    # If you want to send an information, use $self->info('text').
54
    PE_INFO                             => -3,
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
    PE_REDIRECT                         => -2,
    PE_DONE                             => -1,
    PE_OK                               => 0,
    PE_SESSIONEXPIRED                   => 1,
    PE_FORMEMPTY                        => 2,
    PE_WRONGMANAGERACCOUNT              => 3,
    PE_USERNOTFOUND                     => 4,
    PE_BADCREDENTIALS                   => 5,
    PE_LDAPCONNECTFAILED                => 6,
    PE_LDAPERROR                        => 7,
    PE_APACHESESSIONERROR               => 8,
    PE_FIRSTACCESS                      => 9,
    PE_BADCERTIFICATE                   => 10,
    PE_PP_ACCOUNT_LOCKED                => 21,
    PE_PP_PASSWORD_EXPIRED              => 22,
    PE_CERTIFICATEREQUIRED              => 23,
    PE_ERROR                            => 24,
    PE_PP_CHANGE_AFTER_RESET            => 25,
    PE_PP_PASSWORD_MOD_NOT_ALLOWED      => 26,
    PE_PP_MUST_SUPPLY_OLD_PASSWORD      => 27,
    PE_PP_INSUFFICIENT_PASSWORD_QUALITY => 28,
    PE_PP_PASSWORD_TOO_SHORT            => 29,
    PE_PP_PASSWORD_TOO_YOUNG            => 30,
    PE_PP_PASSWORD_IN_HISTORY           => 31,
79
80
81
82
    PE_PP_GRACE                         => 32,
    PE_PP_EXP_WARNING                   => 33,
    PE_PASSWORD_MISMATCH                => 34,
    PE_PASSWORD_OK                      => 35,
83
    PE_NOTIFICATION                     => 36,
Yadd's avatar
Yadd committed
84
    PE_BADURL                           => 37,
85
    PE_NOSCHEME                         => 38,
Clément OUDOT's avatar
Clément OUDOT committed
86
    PE_BADOLDPASSWORD                   => 39,
87
    PE_MALFORMEDUSER                    => 40,
88
    PE_SESSIONNOTGRANTED                => 41,
Yadd's avatar
Yadd committed
89
    PE_CONFIRM                          => 42,
90
91
92
93
    PE_MAILFORMEMPTY                    => 43,
    PE_BADMAILTOKEN                     => 44,
    PE_MAILERROR                        => 45,
    PE_MAILOK                           => 46,
Clément OUDOT's avatar
Clément OUDOT committed
94
    PE_LOGOUT_OK                        => 47,
95
96
97
98
99
100
101
102
103
104

    # Portal messages
    PM_USER                  => 0,
    PM_DATE                  => 1,
    PM_IP                    => 2,
    PM_SESSIONS_DELETED      => 3,
    PM_OTHER_SESSIONS        => 4,
    PM_REMOVE_OTHER_SESSIONS => 5,
    PM_PP_GRACE              => 6,
    PM_PP_EXP_WARNING        => 7,
Clément OUDOT's avatar
Clément OUDOT committed
105
106
107
    PM_SAML_IDPSELECT        => 8,
    PM_SAML_IDPCHOOSEN       => 9,
    PM_REMEMBERCHOICE         => 10,
108
};
109

Yadd's avatar
Yadd committed
110
# EXPORTER PARAMETERS
111
our @EXPORT = qw( PE_INFO PE_REDIRECT PE_DONE PE_OK PE_SESSIONEXPIRED
Yadd's avatar
Yadd committed
112
113
114
115
116
117
118
119
  PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
  PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS
  PE_BADCERTIFICATE PE_PP_ACCOUNT_LOCKED PE_PP_PASSWORD_EXPIRED
  PE_CERTIFICATEREQUIRED PE_ERROR PE_PP_CHANGE_AFTER_RESET
  PE_PP_PASSWORD_MOD_NOT_ALLOWED PE_PP_MUST_SUPPLY_OLD_PASSWORD
  PE_PP_INSUFFICIENT_PASSWORD_QUALITY PE_PP_PASSWORD_TOO_SHORT
  PE_PP_PASSWORD_TOO_YOUNG PE_PP_PASSWORD_IN_HISTORY PE_PP_GRACE
  PE_PP_EXP_WARNING PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION
Clément OUDOT's avatar
Clément OUDOT committed
120
  PE_BADURL PE_NOSCHEME PE_BADOLDPASSWORD PE_MALFORMEDUSER PE_SESSIONNOTGRANTED
121
  PE_CONFIRM PE_MAILFORMEMPTY PE_BADMAILTOKEN PE_MAILERROR PE_MAILOK
Clément OUDOT's avatar
Clément OUDOT committed
122
  PE_LOGOUT_OK
123
  PM_USER PM_DATE PM_IP PM_SESSIONS_DELETED PM_OTHER_SESSIONS
124
  PM_REMOVE_OTHER_SESSIONS PM_PP_GRACE PM_PP_EXP_WARNING
Clément OUDOT's avatar
Clément OUDOT committed
125
  PM_SAML_IDPSELECT PM_SAML_IDPCHOOSEN PM_REMEMBERCHOICE
Yadd's avatar
Yadd committed
126
);
127
our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );
128
129
130

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

131
# Secure jail
132
our $safe;
133
134
our $self;    # Safe cannot share a variable declared with my

135
##@cmethod Lemonldap::NG::Portal::Simple new(hashRef args)
Yadd's avatar
Yadd committed
136
# Class constructor.
137
#@param args hash reference
Yadd's avatar
Yadd committed
138
#@return Lemonldap::NG::Portal::Simple object
139
sub new {
140

141
    binmode( STDOUT, ":utf8" );
142
    my $class = shift;
143
    return $class if ( ref($class) );
144
    my $self = $class->SUPER::new();
145
146

    # Reinit _url
147
    $self->{_url} = '';
148
149

    # Get global configuration
150
151
152
    $self->getConf(@_)
      or $self->abort( "Configuration error",
        "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
153
154

    # Default values
Yadd's avatar
Yadd committed
155
    $self->setDefaultValues();
156
157

    # Test mandatory elements
158
159
    $self->abort( "Configuration error",
        "You've to indicate a an Apache::Session storage module !" )
160
161
      unless ( $self->{globalStorage} );
    eval "require " . $self->{globalStorage};
162
163
164
165
166
167
    $self->abort( "Configuration error",
        "Module " . $self->{globalStorage} . " not found in \@INC" )
      if ($@);
    $self->abort( "Configuration error",
        "You've to indicate a domain for cookies" )
      unless ( $self->{domain} );
168
    $self->{domain} =~ s/^([^\.])/.$1/;
169
170

    # Rules to allow redirection
Yadd's avatar
Yadd committed
171
172
173
174
    $self->{mustRedirect} = (
        ( $ENV{REQUEST_METHOD} eq 'POST' and not $self->param('newpassword') )
          or $self->param('logout')
    ) ? 1 : 0;
Yadd's avatar
Yadd committed
175

176
177
178
    # Push authentication/userDB/passwordDb/issuerDB modules in @ISA
    foreach (qw(authentication userDB passwordDB issuerDB)) {
        my $module_name = 'Lemonldap::NG::Portal::';
Yadd's avatar
Yadd committed
179
180
        my $db_type     = $_;
        my $db_name     = $self->{$db_type};
181
182
183
184
185
186
187
188
189
190
191
192
193
194

        # Adapt module type to real module name
        $db_type =~ s/authentication/Auth/;
        $db_type =~ s/userDB/UserDB/;
        $db_type =~ s/passwordDB/PasswordDB/;
        $db_type =~ s/issuerDB/IssuerDB/;

        # Full module name
        $module_name .= $db_type . $db_name;

        # Remove white spaces
        $module_name =~ s/\s.*$//;

        # Try to load module
Clément OUDOT's avatar
Clément OUDOT committed
195
196
        $self->abort( "Configuration error", "Unable to load $module_name" )
          unless $self->loadModule($module_name);
197
198
199

        # $self->{authentication} and $self->{userDB} can contains arguments
        # (key1 = scalar_value; key2 = ...)
200
201
202
        unless ( $db_name =~ /^Multi/ ) {
            $db_name =~ s/^\w+\s*//;
            my %h = split( /\s*[=;]\s*/, $db_name ) if ($db_name);
203
204
            %$self = ( %h, %$self );
        }
205
    }
206
207

    # Notifications
208
    if ( $self->{notification} ) {
209
        require Lemonldap::NG::Portal::Notification;
210
211
212
213
214
        my $tmp;
        if ( $self->{notificationStorage} ) {
            $tmp = $self->{notificationStorage};
        }
        else {
Yadd's avatar
Yadd committed
215
            (%$tmp) = ( %{ $self->{lmConf} } );
216
217
218
            $self->abort( "notificationStorage not defined",
                "This parameter is required to use notification system" )
              unless ( ref($tmp) );
Yadd's avatar
Yadd committed
219
            $tmp->{type} =~ s/.*:://;
220
221
            $tmp->{table} = 'notifications';
        }
Yadd's avatar
Yadd committed
222
        $tmp->{p}            = $self;
223
224
225
        $self->{notifObject} = Lemonldap::NG::Portal::Notification->new($tmp);
        $self->abort($Lemonldap::NG::Portal::Notification::msg)
          unless ( $self->{notifObject} );
226
    }
227
228

    # SOAP
229
230
231
    if ( $self->{Soap} or $self->{soap} ) {
        require Lemonldap::NG::Portal::_SOAP;
        push @ISA, 'Lemonldap::NG::Portal::_SOAP';
Yadd's avatar
Yadd committed
232
233
234
        if ( $self->{notification} ) {
            $self->{CustomSOAPServices}->{'/notification'} = 'newNotification';
        }
235
        $self->startSoapServices();
236
    }
237
238

    # Trusted domains
239
240
241
    unless ( defined( $self->{trustedDomains} ) ) {
        $self->{trustedDomains} = $self->{domain};
    }
Yadd's avatar
Yadd committed
242
243
244
245
    if ( $self->{trustedDomains} eq '*' ) {
        $self->{trustedDomains} = '|\w[\w\-\.]*\w';
    }
    elsif ( $self->{trustedDomains} ) {
246
247
248
249
        $self->{trustedDomains} = '|(?:[^/]*)?(?:'
          . join( '|',
            ( map { s/\./\\\./g; $_ } split /\s+/, $self->{trustedDomains} ) )
          . ')';
250
    }
251

252
253
254
    return $self;
}

Clément OUDOT's avatar
Clément OUDOT committed
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
##@method boolean loadModule(string module)
# Load a module into portal namespace
# @param module module name
# @return boolean
sub loadModule {
    my $self   = shift;
    my $module = shift;

    return 1 unless $module;

    # Load module test
    eval "require $module";
    if ($@) {
        $self->lmLog( "$module load error: $@", 'error' );
        return 0;
    }

    # Push module in @ISA
    push @ISA, $module;
    return 1;
}

277
##@method protected boolean getConf(hashRef args)
Yadd's avatar
Yadd committed
278
# Copy all parameters in caller object.
279
#@param args hash-ref
Yadd's avatar
Yadd committed
280
#@return True
281
282
283
284
285
286
287
288
289
290
291
292
293
sub getConf {
    my ($self) = shift;
    my %args;
    if ( ref( $_[0] ) ) {
        %args = %{ $_[0] };
    }
    else {
        %args = @_;
    }
    %$self = ( %$self, %args );
    1;
}

Yadd's avatar
Yadd committed
294
295
296
297
##@method protected void setDefaultValues()
# Set default values.
sub setDefaultValues {
    my $self = shift;
Clément OUDOT's avatar
Portal:    
Clément OUDOT committed
298
299
    $self->{portal} ||=
      "http" . ( $ENV{HTTPS} ? 's' : '' ) . '://' . $self->server_name();
Yadd's avatar
Yadd committed
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
    $self->{whatToTrace} ||= 'uid';
    $self->{whatToTrace} =~ s/^\$//;
    $self->{httpOnly} = 1 unless ( defined( $self->{httpOnly} ) );
    $self->{portalSkin} ||= 'pastel';
    $self->{portalDisplayLogout} = 1
      unless ( defined( $self->{portalDisplayLogout} ) );
    $self->{portalDisplayResetPassword} = 1
      unless ( defined( $self->{portalDisplayResetPassword} ) );
    $self->{portalDisplayChangePassword} = 1
      unless ( defined( $self->{portalDisplayChangePassword} ) );
    $self->{portalDisplayAppslist} = 1
      unless ( defined( $self->{portalDisplayAppslist} ) );
    $self->{portalAutocomplete} ||= "off";
    $self->{portalRequireOldPassword} = 1
      unless ( defined( $self->{portalRequireOldPassword} ) );
315
316
    $self->{portalOpenLinkInNewWindow} = 0
      unless ( defined( $self->{portalOpenLinkInNewWindow} ) );
317
318
319
320
    $self->{portalForceAuthn} = 0
      unless ( defined( $self->{portalForceAuthn} ) );
    $self->{portalForceAuthnInterval} = 5
      unless ( defined( $self->{portalForceAuthnInterval} ) );
Yadd's avatar
Yadd committed
321
322
323
324
325
326
327
328
329
    $self->{portalUserAttr} ||= "_user";
    $self->{securedCookie}  ||= 0;
    $self->{cookieName}     ||= "lemonldap";
    $self->{authentication} ||= 'LDAP';
    $self->{authentication} =~ s/^ldap/LDAP/;
    $self->{SMTPServer}     ||= 'localhost';
    $self->{mailLDAPFilter} ||= '(&(mail=$mail)(objectClass=inetOrgPerson))';
    $self->{randomPasswordRegexp} ||= '[A-Z]{3}[a-z]{5}.\d{2}';
    $self->{mailFrom}             ||= "noreply@" . $self->{domain};
Clément OUDOT's avatar
Portal:    
Clément OUDOT committed
330
331
332
    $self->{mailSubject}          ||= "[LemonLDAP::NG] Your new password";
    $self->{mailConfirmSubject} ||=
      "[LemonLDAP::NG] Password reset confirmation";
333
334
    $self->{mailSessionKey} ||= 'mail';
    $self->{mailUrl}        ||= $self->{portal} . "/mail.pl";
Yadd's avatar
Yadd committed
335
    $self->{issuerDB}             ||= 'Null';
336
337
338

    # Set default userDB and passwordDB to DBI if authentication is DBI
    if ( $self->{authentication} =~ /DBI/i ) {
Yadd's avatar
Yadd committed
339
340
341
        $self->{userDB}     ||= "DBI";
        $self->{passwordDB} ||= "DBI";
    }
Clément OUDOT's avatar
Clément OUDOT committed
342
343
344
345
346
347

    # Set default userDB and passwordDB to Null if authentication is Null
    if ( $self->{authentication} =~ /Null/i ) {
        $self->{userDB}     ||= "Null";
        $self->{passwordDB} ||= "Null";
    }
Yadd's avatar
Yadd committed
348
349
    else {

350
        # Default to LDAP
Yadd's avatar
Yadd committed
351
352
        $self->{userDB}     ||= "LDAP";
        $self->{passwordDB} ||= "LDAP";
353
    }
Clément OUDOT's avatar
Clément OUDOT committed
354

Clément OUDOT's avatar
LDAP:    
Clément OUDOT committed
355
356
357
358
359
360
361
362
    # LDAP
    $self->{ldapGroupObjectClass}         ||= "groupOfNames";
    $self->{ldapGroupAttributeName}       ||= "member";
    $self->{ldapGroupAttributeNameUser}   ||= "dn";
    $self->{ldapGroupAttributeNameGroup}  ||= "dn";
    $self->{ldapGroupAttributeNameSearch} ||= ["cn"];
    $self->{ldapGroupRecursive}           ||= 0;

Clément OUDOT's avatar
Clément OUDOT committed
363
364
    # SAML
    $self->{samlIdPResolveCookie} ||= "lemonldapidp";
Yadd's avatar
Yadd committed
365
366
}

367
368
369
370
371
372
373
374
375
376
=begin WSDL

_IN lang $string Language
_IN code $int Error code
_RETURN $string Error string

=end WSDL

=cut

377
##@method string error(string lang)
Yadd's avatar
Yadd committed
378
# error calls Portal/_i18n.pm to display error in the wanted language.
Yadd's avatar
Yadd committed
379
#@param $lang optional (browser language is used instead)
380
#@return error message
381
382
sub error {
    my $self = shift;
Yadd's avatar
Yadd committed
383
    my $lang = shift || $ENV{HTTP_ACCEPT_LANGUAGE};
384
    my $code = shift || $self->{error};
Yadd's avatar
Yadd committed
385
    my $tmp  = &Lemonldap::NG::Portal::_i18n::error( $code, $lang );
Yadd's avatar
Yadd committed
386
387
    return (
        $ENV{HTTP_SOAPACTION}
Yadd's avatar
Yadd committed
388
        ? SOAP::Data->name( result => $tmp )->type('string')
Yadd's avatar
Yadd committed
389
390
        : $tmp
    );
391
392
}

393
##@method string error_type(int code)
394
# error_type tells if error is positive, warning or negative
Yadd's avatar
Yadd committed
395
396
# @param $code Lemonldap::NG error code
# @return "positive", "warning" or "negative"
397
398
sub error_type {
    my $self = shift;
Yadd's avatar
Yadd committed
399
    my $code = shift || $self->{error};
400
401

    # Positive errors
402
403
404
    return "positive"
      if (
        scalar(
405
406
407
408
            grep { /^$code$/ } (
                PE_REDIRECT, PE_DONE, PE_OK, PE_PASSWORD_OK,
                PE_MAILOK,   PE_LOGOUT_OK,
            )
409
410
        )
      );
411
412

    # Warning errors
413
414
415
    return "warning"
      if (
        scalar(
Yadd's avatar
Yadd committed
416
            grep { /^$code$/ } (
417
418
419
420
                PE_INFO,         PE_SESSIONEXPIRED,
                PE_FORMEMPTY,    PE_FIRSTACCESS,
                PE_PP_GRACE,     PE_PP_EXP_WARNING,
                PE_NOTIFICATION, PE_BADURL,
421
                PE_CONFIRM,      PE_MAILFORMEMPTY,
422
423
424
            )
        )
      );
425
426
427
428
429

    # Negative errors (default)
    return "negative";
}

Yadd's avatar
Yadd committed
430
##@method void header()
431
# Overload CGI::header() to add Lemonldap::NG cookie.
432
433
434
435
436
437
438
439
440
441
sub header {
    my $self = shift;
    if ( $self->{cookie} ) {
        $self->SUPER::header( @_, -cookie => $self->{cookie} );
    }
    else {
        $self->SUPER::header(@_);
    }
}

Yadd's avatar
Yadd committed
442
##@method void redirect()
443
# Overload CGI::redirect() to add Lemonldap::NG cookie.
444
445
sub redirect {
    my $self = shift;
446
447
    if ( $self->{cookie} ) {
        $self->SUPER::redirect( @_, -cookie => $self->{cookie} );
448
449
450
451
452
453
    }
    else {
        $self->SUPER::redirect(@_);
    }
}

454
## @method protected hashref getApacheSession(string id)
Yadd's avatar
Yadd committed
455
456
457
# Try to recover the session corresponding to id and return session datas.
# If $id is set to undef, return a new session.
# @param $id session reference
458
sub getApacheSession {
459
    my ( $self, $id, $noInfo ) = @_;
Yadd's avatar
Yadd committed
460
    my %h;
461

Yadd's avatar
Yadd committed
462
    # Trying to recover session from global session storage
Yadd's avatar
Yadd committed
463
    eval { tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions}; };
Yadd's avatar
Yadd committed
464
    if ( $@ or not tied(%h) ) {
465

Yadd's avatar
Yadd committed
466
        # Session not available (expired ?)
467
468
469
        if ($id) {
            $self->lmLog( "Session $id isn't yet available ($ENV{REMOTE_ADDR})",
                'info' );
470
        }
Yadd's avatar
Yadd committed
471
472
        else {
            $self->lmLog( "Unable to create new session: $@", 'error' );
473
        }
Yadd's avatar
Yadd committed
474
        return 0;
475
    }
476
477
    $self->setApacheUser( $h{ $self->{whatToTrace} } )
      if ( $id and not $noInfo );
478
    $self->{id} = $h{_session_id};
Yadd's avatar
Yadd committed
479
    return \%h;
480
481
}

482
##@method void updateSession(hashRef infos)
483
484
485
486
# Update session stored.
# If lemonldap cookie exists, reads it and search session. If the session is
# available, update datas with $info.
#@param $infos hash
487
sub updateSession {
488
489

    # TODO: update all caches
490
    my $self    = shift;
491
    my ($infos) = @_;
492
493
494
495
496
497
    my %cookies = fetch CGI::Cookie;

    # Test if Lemonldap::NG cookie is available
    if ( $cookies{ $self->{cookieName} }
        and my $id = $cookies{ $self->{cookieName} }->value )
    {
498
        my $h = $self->getApacheSession($id) or return undef;
499
500
501

        # Store/update session values
        foreach ( keys %$infos ) {
Yadd's avatar
Yadd committed
502
            $h->{$_} = $infos->{$_};
503
504
        }

505
506
507
        # Store updateTime
        $h->{updateTime} = &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );

Yadd's avatar
Yadd committed
508
        untie %$h;
509
510
511
512
    }

}

Yadd's avatar
Yadd committed
513
##@method protected int _subProcess(array @subs)
514
515
516
# Execute methods until an error is returned.
# If $self->{$sub} exists, launch it, else launch $self->$sub
#@param @subs array list of subroutines
Yadd's avatar
Yadd committed
517
#@return Lemonldap::NG::Portal error
518
519
520
521
522
523
sub _subProcess {
    my $self = shift;
    my @subs = @_;
    my $err  = undef;

    foreach my $sub (@subs) {
Yadd's avatar
Yadd committed
524
525
        last if ( $err = $self->_sub($sub) );
    }
526
527
    return $err;
}
Clément OUDOT's avatar
Clément OUDOT committed
528

Yadd's avatar
Yadd committed
529
##@method protected void updateStatus()
530
531
532
# Inform status mechanism module.
# If an handler is launched on the same server with "status=>1", inform the
# status module with the result (portal error).
533
sub updateStatus {
Yadd's avatar
Yadd committed
534
    my $self = shift;
535
536
537
538
539
540
541
    print $Lemonldap::NG::Handler::Simple::statusPipe (
        $self->{user} ? $self->{user} : $ENV{REMOTE_ADDR} )
      . " => $ENV{SERVER_NAME}$ENV{SCRIPT_NAME} "
      . $self->{error} . "\n"
      if ($Lemonldap::NG::Handler::Simple::statusPipe);
}

542
543
##@method protected string notification()
#@return Notification stored by checkNotification()
544
sub notification {
Yadd's avatar
Yadd committed
545
    my $self = shift;
546
547
548
    return $self->{_notification};
}

549
##@method protected string get_url()
Yadd's avatar
Yadd committed
550
# Return url parameter
Yadd's avatar
Yadd committed
551
# @return url parameter if good, nothing else.
552
sub get_url {
Yadd's avatar
Yadd committed
553
    my $self = shift;
554
    return $self->{_url};
555
}
Yadd's avatar
Yadd committed
556

Clément OUDOT's avatar
Clément OUDOT committed
557
558
559
560
561
562
##@method protected string get_user()
# Return user parameter
# @return user parameter if good, nothing else.
sub get_user {
    my $self = shift;
    return "" unless $self->{user};
563
564
565
566
567
    return $self->{user}
      unless ( $self->{user} =~ m/(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ );
    $self->lmLog(
        "XSS attack detected (param: user | value: " . $self->{user} . ")",
        "warn" );
Clément OUDOT's avatar
Clément OUDOT committed
568
569
570
    return "";
}

Yadd's avatar
Yadd committed
571
##@method private Safe safe()
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
# Provide the security jail.
#@return Safe object
sub safe {
    my $self = shift;
    return $safe if ($safe);
    $safe = new Safe;
    my @t =
      $self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
    foreach (@t) {
        my $sub = $_;
        unless (/::/) {
            $sub = ref($self) . "::$_";
        }
        else {
            s/^.*:://;
        }
        next if ( $self->can($_) );
        eval "sub $_ {
                return $sub( '$self->{portal}', \@_ );
            }";
Yadd's avatar
Yadd committed
592
        $self->lmLog( $@, 'error' ) if ($@);
593
    }
Yadd's avatar
Yadd committed
594
    $safe->share_from( 'main', ['%ENV'] );
Yadd's avatar
Yadd committed
595
596
    $safe->share_from( 'Lemonldap::NG::Common::Safelib',
        $Lemonldap::NG::Common::Safelib::functions );
Yadd's avatar
Yadd committed
597
    $safe->share( '&encode_base64', @t );
598
599
600
    return $safe;
}

Clément OUDOT's avatar
Clément OUDOT committed
601
##@method private boolean _deleteSession(Apache::Session* h, boolean preserveCookie)
602
603
# Delete an existing session. If "securedCookie" is set to 2, the http session
# will also be removed.
Clément OUDOT's avatar
Clément OUDOT committed
604
605
# @param h tied Apache::Session object
# @param preserveCookie do not delete cookie
606
# @return True if session has been deleted
607
sub _deleteSession {
Yadd's avatar
Yadd committed
608
    my ( $self, $h, $preserveCookie ) = @_;
Clément OUDOT's avatar
Clément OUDOT committed
609
    my $result = 1;
610
611

    # Try to find a linked http session (securedCookie=>2)
612
    if ( my $id2 = $h->{_httpSession} ) {
613
614
615
616
617
        if ( my $h2 = $self->getApacheSession($id2) ) {

            # Try to purge local cache
            # (if an handler is running on the same server)
            eval { $self->{lmConf}->{refLocalStorage}->remove($id2); };
618
619
            eval { tied(%$h2)->delete() };
            $self->lmLog( $@, 'error' ) if ($@);
620

621
            # Create an obsolete cookie to remove it
622
623
624
625
626
627
628
629
630
631
632
            push @{ $self->{cookie} },
              $self->cookie(
                -name    => $self->{cookieName} . 'http',
                -value   => 0,
                -domain  => $self->{domain},
                -path    => "/",
                -secure  => 0,
                -expires => '-1d',
                @_,
              );
        }
633
    }
Clément OUDOT's avatar
Clément OUDOT committed
634
635

    my $logged_user = $h->{ $self->{whatToTrace} };
636
637
638
639

    # Try to purge local cache
    # (if an handler is running on the same server)
    eval { $self->{lmConf}->{refLocalStorage}->remove( $h->{_session_id} ); };
Clément OUDOT's avatar
Clément OUDOT committed
640
641
642
643
644
    eval { tied(%$h)->delete() };
    if ($@) {
        $self->lmLog( $@, 'error' );
        $result = 0;
    }
645

646
    # Create an obsolete cookie to remove it
647
648
649
650
651
652
653
654
655
    push @{ $self->{cookie} },
      $self->cookie(
        -name    => $self->{cookieName},
        -value   => 0,
        -domain  => $self->{domain},
        -path    => "/",
        -secure  => 0,
        -expires => '-1d',
        @_,
Yadd's avatar
Yadd committed
656
      ) unless ($preserveCookie);
657
658

    # Log
Clément OUDOT's avatar
Clément OUDOT committed
659
    $self->_sub( 'userNotice', "User $logged_user has been disconnected" );
660
661

    # Return the result of tied(%$h)->delete()
Clément OUDOT's avatar
Clément OUDOT committed
662
    return $result;
663
664
}

Clément OUDOT's avatar
Clément OUDOT committed
665
666
667
668
669
670
671
672
673
674
675
676
677
678
##@method private void _dump( variable )
# Dump variable in debug mode
# @param $variable
# @return void
sub _dump {
	my $self = shift;
	my $variable = shift;

	use Data::Dumper;
    $self->lmLog( "Dump: " . Dumper($variable), 'debug' );

	return;
}

Yadd's avatar
Yadd committed
679
680
681
682
683
684
##@method protected string info(string t)
# Get or set info to display to the user.
# @param $t optional text to store
# @return HTML text to display
sub info {
    my ( $self, $t ) = @_;
685
    $self->{_info} .= $t if ( defined $t );
Yadd's avatar
Yadd committed
686
687
688
    return $self->{_info};
}

Yadd's avatar
Yadd committed
689
690
691
692
693
###############################################################
# MAIN subroutine: call all steps until one returns something #
#                  different than PE_OK                       #
###############################################################

Yadd's avatar
Yadd committed
694
##@method boolean process()
695
696
697
698
699
700
701
702
# Main method calling functions issued from:
#  - itself:
#    - controlUrlOrigin
#    - checkNotifBack
#    - controlExistingSession
#    - setMacros
#    - setLocalGroups
#    - removeOther
703
#    - grantSession
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
#    - store
#    - buildCookie
#    - checkNotification
#    - autoRedirect
#    - updateStatus
#  - authentication module:
#    - authInit
#    - extractFormInfo
#    - setAuthSessionInfo
#    - authenticate
#  - userDB module:
#    - userDBInit
#    - getUser
#    - setSessionInfo
#    - setGroups
#  - passwordDB module:
#    - passwordDBInit
#    - modifyPassword
#  - issuerDB module:
#    - issuerDBInit
#    - issuerForUnAuthUser
#    - issuerForAuthUser
#
#@return 1 if all is OK, 0 if session isn't created or a notification has to be done
Yadd's avatar
Yadd committed
728
729
730
731
sub process {
    my ($self) = @_;
    $self->{error} = PE_OK;
    $self->{error} = $self->_subProcess(
732
733
        qw(controlUrlOrigin checkNotifBack controlExistingSession issuerDBInit
          issuerForUnAuthUser authInit extractFormInfo userDBInit getUser
734
          setAuthSessionInfo passwordDBInit modifyPassword setSessionInfo
735
736
          setMacros setLocalGroups setGroups authenticate removeOther
          grantSession store buildCookie checkNotification issuerForAuthUser
737
          autoRedirect)
Yadd's avatar
Yadd committed
738
739
740
741
742
    );
    $self->updateStatus;
    return ( ( $self->{error} > 0 ) ? 0 : 1 );
}

743
##@apmethod int controlUrlOrigin()
744
# If the user was redirected here, loads 'url' parameter.
Yadd's avatar
Yadd committed
745
#@return Lemonldap::NG::Portal constant
746
747
sub controlUrlOrigin {
    my $self = shift;
748
    $self->{_url} ||= '';
Yadd's avatar
Yadd committed
749
    if ( my $url = $self->param('url') ) {
750
751

        # REJECT NON BASE64 URL
Clément OUDOT's avatar
Clément OUDOT committed
752
        if ( $url =~ m#[^A-Za-z0-9\+/=]# ) {
753
754
            $self->lmLog( "XSS attack detected (param: url | value: $url)",
                "warn" );
Clément OUDOT's avatar
Clément OUDOT committed
755
756
            return PE_BADURL;
        }
757

Yadd's avatar
Yadd committed
758
        $self->{urldc} = decode_base64($url);
Yadd's avatar
Yadd committed
759
        $self->{urldc} =~ s/[\r\n]//sg;
760

761
        # REJECT [\0<'"`] in URL or encoded '%' and non protected hosts
762
        if (
Yadd's avatar
Yadd committed
763
            $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/
Yadd's avatar
Yadd committed
764
            or ( $self->{urldc} !~
765
m#^https?://(?:$self->{reVHosts}$self->{trustedDomains})(?::\d+)?(?:/.*)?$#o
766
767
                and not $self->param('logout') )
          )
768
        {
769
770
771
772
773
            $self->lmLog(
                "XSS attack detected (param: urldc | value: "
                  . $self->{urldc} . ")",
                "warn"
            );
774
            delete $self->{urldc};
775
776
            return PE_BADURL;
        }
777
        $self->{_url} = $url;
778
779
780
781
    }
    PE_OK;
}

782
##@apmethod int checkNotifBack()
783
# Checks if a message has been notified to the connected user.
784
785
786
787
788
789
790
791
792
793
794
# Call Lemonldap::NG::Portal::Notification::checkNotification()
#@return Lemonldap::NG::Portal error code
sub checkNotifBack {
    my $self = shift;
    if ( $self->{notification} and grep( /^reference/, $self->param() ) ) {
        unless ( $self->{notifObject}->checkNotification($self) ) {
            $self->{_notification} =
              $self->{notifObject}->getNotification($self);
            return PE_NOTIFICATION;
        }
        else {
Yadd's avatar
Yadd committed
795
            $self->{error} = $self->_subProcess(
796
                qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect)
Yadd's avatar
Yadd committed
797
            );
798
799
800
801
802
803
            return $self->{error} || PE_DONE;
        }
    }
    PE_OK;
}

804
##@apmethod int controlExistingSession(string id)
805
# Control existing sessions.
Yadd's avatar
Yadd committed
806
# To overload to control what to do with existing sessions.
807
# what to do with existing sessions ?
Yadd's avatar
Yadd committed
808
809
#       - nothing: user is authenticated and process returns true (default)
#       - delete and create a new session (not implemented)
810
#       - re-authentication (set portalForceAuthn to 1)
811
#@param $id optional value of the session-id else cookies are examinated.
Yadd's avatar
Yadd committed
812
#@return Lemonldap::NG::Portal constant
813
sub controlExistingSession {
814
815
816
    my ( $self, $id ) = @_;
    my %cookies;
    %cookies = fetch CGI::Cookie unless ($id);
817

818
    # Test if Lemonldap::NG cookie is available
819
820
821
822
823
    if (
        $id
        or (    $cookies{ $self->{cookieName} }
            and $id = $cookies{ $self->{cookieName} }->value )
      )
824
    {
825
        my $h = $self->getApacheSession($id) or return PE_OK;
826
        %{ $self->{sessionInfo} } = %$h;
Yadd's avatar
Yadd committed
827

828
        # Logout if required
829
830
        if ( $self->param('logout') ) {

831
            # Delete session in global storage
832
833
834
835
            unless ( $self->_deleteSession($h) ) {
                $self->lmLog( "Unable to delete session $id", 'error' );
                return PE_ERROR;
            }
Clément OUDOT's avatar
Clément OUDOT committed
836
837
838
839
840
841
842
843
844
845
846
847
848

            # Call issuerDB logout
            eval { $self->_sub('issuerLogout'); };
            if ($@) {
                $self->lmLog( "Error when calling issuerLogout: $@", 'debug' );
            }

            # Call authentication logout
            eval { $self->_sub('authLogout'); };
            if ($@) {
                $self->lmLog( "Error when calling authLogout: $@", 'debug' );
            }

849
850
            # Display logout message
            return PE_LOGOUT_OK;
Yadd's avatar
Yadd committed
851
        }
Yadd's avatar
Yadd committed
852
853
854
855
856
857
858

        # If the user wants to purge other sessions
        elsif ( $self->param('removeOther') ) {
            $self->{notifyDeleted} = 1;
            $self->{singleSession} = 1;
            $self->_sub( 'removeOther', $id );
        }
859
        untie %$h;
860
        $self->{id} = $id;
861

862
        # A session has been find => calling &existingSession
863
        my $r = $self->_sub( 'existingSession', $id, $self->{sessionInfo} );
864
        if ( $r == PE_DONE ) {
Yadd's avatar
Yadd committed
865
866
867
            $self->{error} = $self->_subProcess(
                qw(checkNotification issuerDBInit issuerForAuthUser autoRedirect)
            );
868
869
870
871
872
873
874
875
876
            return $self->{error} || PE_DONE;
        }
        else {
            return $r;
        }
    }
    PE_OK;
}

877
878
879
## @method int existingSession()
# Launched by controlExistingSession() to know what to do with existing
# sessions.
880
881
882
# Can return:
# - PE_DONE: session is unchanged and process() return true
# - PE_OK: process() return false to display the form
883
#@return Lemonldap::NG::Portal constant
884
sub existingSession {
885
886
887
888
889
890
891
    my $self = shift;

    # Check portalForceAuthn parameter
    if ( $self->{portalForceAuthn} ) {
        my $referer = $self->referer();
        my $id      = $self->{id};

892
893
894
895
896
897
898
899
900
901
902
903
904
        # Do not force authentication when password is modified
        return PE_DONE if $self->param('newpassword');

       # Do not force authentication if last successful authentication is recent
        my $last_authn_utime = $self->{sessionInfo}->{_lastAuthnUTime} || 0;
        if ( time() - $last_authn_utime < $self->{portalForceAuthnInterval} ) {
            $self->lmLog(
"Authentication is recent, so do not force authentication for session $id",
                'debug'
            );
            return PE_DONE;
        }

905
     # If coming from the portal follow the normal process to update the session
906
907
908
909
910
911
912
913
        if ( $referer ? ( $referer =~ m#$self->{portal}#i ) : 0 ) {
            $self->lmLog( "Portal referer detected for session $id", 'debug' );

            # Set flag to update session timestamp
            $self->{updateSession} = 1;

            # Process
            $self->{error} = $self->_subProcess(
914
                qw(issuerDBInit issuerForUnAuthUser authInit extractFormInfo
915
                  userDBInit getUser setAuthSessionInfo setSessionInfo
916
                  setMacros setLocalGroups setGroups authenticate
917
                  store)
918
919
920
921
922
923
924
925
926
927
            );
            return $self->{error} || PE_DONE;
        }
        else {
            $self->lmLog( "Force reauthentication for session $id", 'debug' );
            return PE_OK;
        }
    }

    # Else return PE_DONE
928
    PE_DONE;
929
930
}

931
932
933
934
935
936
937
938
## @apmethod int issuerDBInit()
# Set _issuerDB
# call issuerDBInit in issuerDB* module
# @return Lemonldap::NG::Portal constant
sub issuerDBInit {
    my $self = shift;
    my $issuerDB;

Clément OUDOT's avatar
Clément OUDOT committed
939
    # Get the current issuer module
940
941
942
943
944
945
        $issuerDB = $self->{issuerDB};

    $self->{sessionInfo}->{_issuerDB} = $issuerDB;

    return $self->SUPER::issuerDBInit();
}
946

Clément OUDOT's avatar
Clément OUDOT committed
947
948
949
950
951
952
953
954
# issuerForUnAuthUser(): must be implemented in IssuerDB* module

# authInit(): must be implemented in Auth* module

# extractFormInfo(): must be implemented in Auth* module
# * set $self->{user}
# * authenticate user if possible (or do it in authenticate())

955
# getUser(): must be implemented in UserDB* module
Clément OUDOT's avatar
Clément OUDOT committed
956

957
958
959
960
961
962
963
964
965
## @apmethod int setAuthSessionInfo()
# Set _auth
# call setAuthSessionInfo in Auth* module
#@return Lemonldap::NG::Portal constant
sub setAuthSessionInfo {
    my $self = shift;
    my $auth;

    # Get the current authentication module
Clément OUDOT's avatar
Clément OUDOT committed
966
967
    if ( defined $self->{_multi}->{stack}->[0] ) {
        $auth = $self->{_multi}->{stack}->[0]->[0]->{n};
968
969
970
971
972
973
    }
    else {
        $auth = $self->{authentication};
    }

    $self->{sessionInfo}->{_auth} = $auth;
974

975
976
977
978
979
980
981
982
983
984
985
    return $self->SUPER::setAuthSessionInfo();
}

## @apmethod int passwordDBInit()
# Set _passwordDB
# call passwordDBInit in passwordDB* module
# @return Lemonldap::NG::Portal constant
sub passwordDBInit {
    my $self = shift;
    my $passwordDB;

Clément OUDOT's avatar
Clément OUDOT committed
986
    # Get the current password module
987
988
989
990
991
992
        $passwordDB = $self->{passwordDB};

    $self->{sessionInfo}->{_passwordDB} = $passwordDB;

    return $self->SUPER::passwordDBInit();
}
993
994

# modifyPassword(): must be implemented in PasswordDB* module
Clément OUDOT's avatar
Clément OUDOT committed
995

996
##@apmethod int setSessionInfo()
997
998
# Set ipAddr, xForwardedForAddr, startTime, updateTime, _utime and _userDB
# Call setSessionInfo() in UserDB* module
999
1000
1001
#@return Lemonldap::NG::Portal constant
sub setSessionInfo {
    my $self = shift;
1002
1003
    my $userDB;

Clément OUDOT's avatar
Clément OUDOT committed
1004
1005
1006
    # Get the current user module
    if ( defined $self->{_multi}->{stack}->[1] ) {
        $userDB = $self->{_multi}->{stack}->[1]->[0]->{n};
1007
1008
1009
1010
1011
1012
    }
    else {
        $userDB = $self->{userDB};
    }

    $self->{sessionInfo}->{_userDB} = $userDB;
1013

Yadd's avatar
Yadd committed
1014
    # Store IP address
1015
    $self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR};
Yadd's avatar
Yadd committed
1016
1017
1018
    $self->lmLog(
        "Store ipAddr: " . $self->{sessionInfo}->{ipAddr} . " in session",
        'debug' );
1019

Yadd's avatar
Yadd committed
1020
    # Extract and store client IP from X-FORWARDED-FOR header
1021
    my $xheader = $ENV{HTTP_X_FORWARDED_FOR};
1022
    $xheader =~ s/(.*?)(\,)+.*/$1/ if $xheader;
1023
    $self->{sessionInfo}->{xForwardedForAddr} = $xheader || $ENV{REMOTE_ADDR};
1024
1025
1026
1027
1028
1029
    $self->lmLog(
        "Store xForwardedForAddr: "
          . $self->{sessionInfo}->{xForwardedForAddr}
          . " in session",
        'debug'
    );
Yadd's avatar
Yadd committed
1030

1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
    if ( $self->{updateSession} ) {
        $self->{sessionInfo}->{updateTime} =
          &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );
        $self->lmLog(
            "Store updateTime: "
              . $self->{sessionInfo}->{updateTime}
              . " in session",
            'debug'
        );
    }
    else {
Yadd's avatar
Yadd committed
1042
1043
1044
    $self->{sessionInfo}->{_utime} = time();
    $self->{sessionInfo}->{startTime} =
      &POSIX::strftime( "%Y%m%d%H%M%S", localtime() );
1045
    $self->lmLog(
1046
1047
1048
            "Store startTime: "
              . $self->{sessionInfo}->{startTime}
              . " in session",
1049
1050
        'debug'
    );