Simple.pm 96.7 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
use POSIX qw(strftime);
18
use Lemonldap::NG::Portal::_i18n;    #inherits
19
use Lemonldap::NG::Common::Captcha;
20
use Lemonldap::NG::Common::Session;
Yadd's avatar
Yadd committed
21
22
use Lemonldap::NG::Common::Apache::Session
  ;    #link protected session Apache::Session object
23
24
use Lemonldap::NG::Common::Safe;    #link protected safe Safe object
use Lemonldap::NG::Common::Safelib;
Yadd's avatar
Yadd committed
25
use Digest::MD5;
26

27
# Special comments for doxygen
Yadd's avatar
Yadd committed
28
#inherits Lemonldap::NG::Portal::_SOAP
Yadd's avatar
Yadd committed
29
#inherits Lemonldap::NG::Portal::AuthApache;
30
#inherits Lemonldap::NG::Portal::AuthAD;
Yadd's avatar
Yadd committed
31
32
33
#inherits Lemonldap::NG::Portal::AuthCAS;
#inherits Lemonldap::NG::Portal::AuthChoice;
#inherits Lemonldap::NG::Portal::AuthDBI;
34
35
#inherits Lemonldap::NG::Portal::AuthFacebook;
#inherits Lemonldap::NG::Portal::AuthGoogle;
Yadd's avatar
Yadd committed
36
37
38
39
40
#inherits Lemonldap::NG::Portal::AuthLDAP;
#inherits Lemonldap::NG::Portal::AuthMulti;
#inherits Lemonldap::NG::Portal::AuthNull;
#inherits Lemonldap::NG::Portal::AuthOpenID;
#inherits Lemonldap::NG::Portal::AuthProxy;
Clément OUDOT's avatar
   
Clément OUDOT committed
41
#inherits Lemonldap::NG::Portal::AuthRadius;
Yadd's avatar
Yadd committed
42
43
44
45
46
#inherits Lemonldap::NG::Portal::AuthRemote;
#inherits Lemonldap::NG::Portal::AuthSAML;
#inherits Lemonldap::NG::Portal::AuthSSL;
#inherits Lemonldap::NG::Portal::AuthTwitter;
#inherits Lemonldap::NG::Portal::Display;
Yadd's avatar
Yadd committed
47
48
49
50
#inherits Lemonldap::NG::Portal::IssuerDBCAS
#inherits Lemonldap::NG::Portal::IssuerDBNull
#inherits Lemonldap::NG::Portal::IssuerDBOpenID
#inherits Lemonldap::NG::Portal::IssuerDBSAML
Yadd's avatar
Yadd committed
51
#inherits Lemonldap::NG::Portal::Menu
52
#link Lemonldap::NG::Common::Notification protected notification
Yadd's avatar
Yadd committed
53
54
55
56
#inherits Lemonldap::NG::Portal::PasswordDBChoice;
#inherits Lemonldap::NG::Portal::PasswordDBDBI;
#inherits Lemonldap::NG::Portal::PasswordDBLDAP;
#inherits Lemonldap::NG::Portal::PasswordDBNull;
57
#inherits Lemonldap::NG::Portal::UserDBAD;
Yadd's avatar
Yadd committed
58
59
#inherits Lemonldap::NG::Portal::UserDBChoice;
#inherits Lemonldap::NG::Portal::UserDBDBI;
60
61
#inherits Lemonldap::NG::Portal::UserDBFacebook;
#inherits Lemonldap::NG::Portal::UserDBGoogle;
Yadd's avatar
Yadd committed
62
63
64
65
66
67
68
#inherits Lemonldap::NG::Portal::UserDBLDAP;
#inherits Lemonldap::NG::Portal::UserDBMulti;
#inherits Lemonldap::NG::Portal::UserDBNull;
#inherits Lemonldap::NG::Portal::UserDBOpenID;
#inherits Lemonldap::NG::Portal::UserDBProxy;
#inherits Lemonldap::NG::Portal::UserDBRemote;
#inherits Lemonldap::NG::Portal::UserDBSAML;
69
#inherits Lemonldap::NG::Portal::PasswordDBDBI
Clément OUDOT's avatar
Clément OUDOT committed
70
#inherits Lemonldap::NG::Portal::PasswordDBLDAP
71
#inherits Apache::Session
Yadd's avatar
Yadd committed
72
#link Lemonldap::NG::Common::Apache::Session::SOAP protected globalStorage
73

Clément OUDOT's avatar
Clément OUDOT committed
74
our $VERSION = '1.9.0';
75

Yadd's avatar
Yadd committed
76
77
use base qw(Lemonldap::NG::Common::CGI Exporter);
our @ISA;
78
79

# Constants
80
use constant {
Yadd's avatar
Yadd committed
81

82
    # Portal errors
Yadd's avatar
Yadd committed
83
84
    # Developers warning, do not use PE_INFO, it's reserved to autoRedirect.
    # If you want to send an information, use $self->info('text').
85
86
    PE_IMG_NOK                          => -5,
    PE_IMG_OK                           => -4,
87
    PE_INFO                             => -3,
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
    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,
112
113
114
115
    PE_PP_GRACE                         => 32,
    PE_PP_EXP_WARNING                   => 33,
    PE_PASSWORD_MISMATCH                => 34,
    PE_PASSWORD_OK                      => 35,
116
    PE_NOTIFICATION                     => 36,
Yadd's avatar
Yadd committed
117
    PE_BADURL                           => 37,
118
    PE_NOSCHEME                         => 38,
Clément OUDOT's avatar
Clément OUDOT committed
119
    PE_BADOLDPASSWORD                   => 39,
120
    PE_MALFORMEDUSER                    => 40,
121
    PE_SESSIONNOTGRANTED                => 41,
Yadd's avatar
Yadd committed
122
    PE_CONFIRM                          => 42,
123
124
125
126
    PE_MAILFORMEMPTY                    => 43,
    PE_BADMAILTOKEN                     => 44,
    PE_MAILERROR                        => 45,
    PE_MAILOK                           => 46,
Clément OUDOT's avatar
Clément OUDOT committed
127
    PE_LOGOUT_OK                        => 47,
Clément OUDOT's avatar
Clément OUDOT committed
128
129
130
131
132
133
134
135
136
137
138
139
    PE_SAML_ERROR                       => 48,
    PE_SAML_LOAD_SERVICE_ERROR          => 49,
    PE_SAML_LOAD_IDP_ERROR              => 50,
    PE_SAML_SSO_ERROR                   => 51,
    PE_SAML_UNKNOWN_ENTITY              => 52,
    PE_SAML_DESTINATION_ERROR           => 53,
    PE_SAML_CONDITIONS_ERROR            => 54,
    PE_SAML_IDPSSOINITIATED_NOTALLOWED  => 55,
    PE_SAML_SLO_ERROR                   => 56,
    PE_SAML_SIGNATURE_ERROR             => 57,
    PE_SAML_ART_ERROR                   => 58,
    PE_SAML_SESSION_ERROR               => 59,
140
141
    PE_SAML_LOAD_SP_ERROR               => 60,
    PE_SAML_ATTR_ERROR                  => 61,
Yadd's avatar
Yadd committed
142
    PE_OPENID_EMPTY                     => 62,
Yadd's avatar
Yadd committed
143
    PE_OPENID_BADID                     => 63,
Yadd's avatar
Yadd committed
144
    PE_MISSINGREQATTR                   => 64,
Yadd's avatar
Yadd committed
145
    PE_BADPARTNER                       => 65,
146
    PE_MAILCONFIRMATION_ALREADY_SENT    => 66,
147
    PE_PASSWORDFORMEMPTY                => 67,
148
    PE_CAS_SERVICE_NOT_ALLOWED          => 68,
149
    PE_MAILFIRSTACCESS                  => 69,
150
    PE_MAILNOTFOUND                     => 70,
151
    PE_PASSWORDFIRSTACCESS              => 71,
152
    PE_MAILCONFIRMOK                    => 72,
Clément OUDOT's avatar
   
Clément OUDOT committed
153
    PE_RADIUSCONNECTFAILED              => 73,
154
    PE_MUST_SUPPLY_OLD_PASSWORD         => 74,
155
    PE_FORBIDDENIP                      => 75,
156
157
    PE_CAPTCHAERROR                     => 76,
    PE_CAPTCHAEMPTY                     => 77,
158
159
    PE_REGISTERFIRSTACCESS              => 78,
    PE_REGISTERFORMEMPTY                => 79,
160
    PE_REGISTERALREADYEXISTS            => 80,
161
162
163
164
165
166
167
168
169
170

    # 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
171
172
    PM_SAML_IDPSELECT        => 8,
    PM_SAML_IDPCHOOSEN       => 9,
Yadd's avatar
Yadd committed
173
    PM_REMEMBERCHOICE        => 10,
174
    PM_SAML_SPLOGOUT         => 11,
175
    PM_REDIRECTION           => 12,
176
    PM_BACKTOSP              => 13,
Clément OUDOT's avatar
Clément OUDOT committed
177
    PM_BACKTOCASURL          => 14,
178
    PM_LOGOUT                => 15,
Yadd's avatar
Yadd committed
179
    PM_OPENID_EXCHANGE       => 16,
180
    PM_CDC_WRITER            => 17,
Yadd's avatar
Yadd committed
181
182
183
    PM_OPENID_RPNS           => 18,    # OpenID "requested parameter is not set"
    PM_OPENID_PA             => 19,    # "OpenID policy available at"
    PM_OPENID_AP             => 20,    # OpenID "Asked parameter"
184
    PM_ERROR_MSG             => 21,
185
186
    PM_LAST_LOGINS           => 22,
    PM_LAST_FAILED_LOGINS    => 23,
187
    PM_OIDC_CONSENT          => 24,
188
189
190
191
192
193
    PM_OIDC_SCOPE_OPENID     => 25,
    PM_OIDC_SCOPE_PROFILE    => 26,
    PM_OIDC_SCOPE_EMAIL      => 27,
    PM_OIDC_SCOPE_ADDRESS    => 28,
    PM_OIDC_SCOPE_PHONE      => 29,
    PM_OIDC_SCOPE_OTHER      => 30,
194
    PM_OIDC_CONFIRM_LOGOUT   => 31,
195
};
196

Yadd's avatar
Yadd committed
197
# EXPORTER PARAMETERS
198
our @EXPORT = qw( PE_IMG_NOK PE_IMG_OK PE_INFO PE_REDIRECT PE_DONE PE_OK
Thomas Chemineau's avatar
SAML:    
Thomas Chemineau committed
199
200
201
  PE_SESSIONEXPIRED 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
Yadd's avatar
Yadd committed
202
203
204
205
206
  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
207
  PE_BADURL PE_NOSCHEME PE_BADOLDPASSWORD PE_MALFORMEDUSER PE_SESSIONNOTGRANTED
208
  PE_CONFIRM PE_MAILFORMEMPTY PE_BADMAILTOKEN PE_MAILERROR PE_MAILOK
Clément OUDOT's avatar
Clément OUDOT committed
209
210
211
212
  PE_LOGOUT_OK PE_SAML_ERROR PE_SAML_LOAD_SERVICE_ERROR PE_SAML_LOAD_IDP_ERROR
  PE_SAML_SSO_ERROR PE_SAML_UNKNOWN_ENTITY PE_SAML_DESTINATION_ERROR
  PE_SAML_CONDITIONS_ERROR PE_SAML_IDPSSOINITIATED_NOTALLOWED PE_SAML_SLO_ERROR
  PE_SAML_SIGNATURE_ERROR PE_SAML_ART_ERROR PE_SAML_SESSION_ERROR
Yadd's avatar
Yadd committed
213
  PE_SAML_LOAD_SP_ERROR PE_SAML_ATTR_ERROR PE_OPENID_EMPTY PE_OPENID_BADID
214
  PE_MISSINGREQATTR PE_BADPARTNER PE_MAILCONFIRMATION_ALREADY_SENT
215
  PE_PASSWORDFORMEMPTY PE_CAS_SERVICE_NOT_ALLOWED PE_MAILFIRSTACCESS
216
  PE_MAILNOTFOUND PE_PASSWORDFIRSTACCESS PE_MAILCONFIRMOK
217
  PE_MUST_SUPPLY_OLD_PASSWORD PE_FORBIDDENIP PE_CAPTCHAERROR PE_CAPTCHAEMPTY
218
  PE_REGISTERFIRSTACCESS PE_REGISTERFORMEMPTY PE_REGISTERALREADYEXISTS
219
  PM_USER PM_DATE PM_IP PM_SESSIONS_DELETED PM_OTHER_SESSIONS
220
  PM_REMOVE_OTHER_SESSIONS PM_PP_GRACE PM_PP_EXP_WARNING
221
  PM_SAML_IDPSELECT PM_SAML_IDPCHOOSEN PM_REMEMBERCHOICE PM_SAML_SPLOGOUT
Yadd's avatar
Yadd committed
222
  PM_REDIRECTION PM_BACKTOSP PM_BACKTOCASURL PM_LOGOUT PM_OPENID_EXCHANGE
223
  PM_CDC_WRITER PM_OPENID_RPNS PM_OPENID_PA PM_OPENID_AP PM_ERROR_MSG
224
225
  PM_LAST_LOGINS PM_LAST_FAILED_LOGINS PM_OIDC_CONSENT PM_OIDC_SCOPE_OPENID
  PM_OIDC_SCOPE_PROFILE PM_OIDC_SCOPE_EMAIL PM_OIDC_SCOPE_ADDRESS
226
  PM_OIDC_SCOPE_PHONE PM_OIDC_SCOPE_OTHER PM_OIDC_CONFIRM_LOGOUT
Yadd's avatar
Yadd committed
227
);
228
our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );
229
230
231

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

232
# Share secure jail between threads
233
our $safe;
234

Yadd's avatar
Yadd committed
235
236
237
238
239
240
241
BEGIN {
    eval {
        require threads::shared;
        threads::shared::share($safe);
    };
}

242
##@cmethod Lemonldap::NG::Portal::Simple new(hashRef args)
Yadd's avatar
Yadd committed
243
# Class constructor.
244
#@param args hash reference
Yadd's avatar
Yadd committed
245
#@return Lemonldap::NG::Portal::Simple object
246
sub new {
247

Yadd's avatar
Yadd committed
248
    @ISA = qw(Lemonldap::NG::Common::CGI Exporter);
249
    binmode( STDOUT, ":utf8" );
250
    my $class = shift;
251
    return $class if ( ref($class) );
Yadd's avatar
Yadd committed
252
    my $self = $class->SUPER::new() or return undef;
253
254

    # Reinit _url
255
    $self->{_url} = '';
256
257

    # Get global configuration
258
259
260
    $self->getConf(@_)
      or $self->abort( "Configuration error",
        "Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
261

Yadd's avatar
Yadd committed
262
263
    $self->{multiValuesSeparator} ||= ';';

264
    # Test mandatory elements
265
266

    # 1. Sessions backend
267
268
    $self->abort( "Configuration error",
        "You've to indicate a an Apache::Session storage module !" )
269
      unless ( $self->{globalStorage} );
270

271
    # Use global storage for all backends by default
272
273
274
275
276
277

    # Persistent
    $self->{persistentStorage} ||= $self->{globalStorage};
    if (   !$self->{persistentStorageOptions}
        or !%{ $self->{persistentStorageOptions} } )
    {
278
279
280
        $self->{persistentStorageOptions} = $self->{globalStorageOptions};
    }

281
282
283
284
285
286
287
288
289
290
291
    # SAML
    $self->{samlStorage} ||= $self->{globalStorage};
    if ( !$self->{samlStorageOptions} or !%{ $self->{samlStorageOptions} } ) {
        $self->{samlStorageOptions} = $self->{globalStorageOptions};
    }

    # CAS
    $self->{casStorage} ||= $self->{globalStorage};
    if ( !$self->{casStorageOptions} or !%{ $self->{casStorageOptions} } ) {
        $self->{casStorageOptions} = $self->{globalStorageOptions};
    }
292

293
294
295
296
297
298
299
300
    # Captcha
    $self->{captchaStorage} ||= $self->{globalStorage};
    if (   !$self->{captchaStorageOptions}
        or !%{ $self->{captchaStorageOptions} } )
    {
        $self->{captchaStorageOptions} = $self->{globalStorageOptions};
    }

301
302
303
    # OpenIDConnect
    $self->{oidcStorage} ||= $self->{globalStorage};
    if ( !$self->{oidcStorageOptions} or !%{ $self->{oidcStorageOptions} } ) {
304
        $self->{oidcStorageOptions} = $self->{globalStorageOptions};
305
306
    }

307
    # 2. Domain
308
309
310
    $self->abort( "Configuration error",
        "You've to indicate a domain for cookies" )
      unless ( $self->{domain} );
311
    $self->{domain} =~ s/^([^\.])/.$1/;
312

313
    # Load Display and Menu functions
314
    $self->loadModule('Lemonldap::NG::Portal::Menu');
315
    $self->loadModule('Lemonldap::NG::Portal::Display');
316

317
    # Rules to allow redirection
318
319
320
321
322
    $self->{mustRedirect} =
      defined $ENV{REQUEST_METHOD}
      ? ( $ENV{REQUEST_METHOD} eq "POST" and not $self->param('newpassword') )
      : $self->param('logout') ? 1
      :                          0;
Yadd's avatar
Yadd committed
323

Clément OUDOT's avatar
SAML:    
Clément OUDOT committed
324
    # Push authentication/userDB/passwordDB modules in @ISA
325
    foreach my $type (qw(authentication userDB passwordDB registerDB)) {
326
        my $module_name = 'Lemonldap::NG::Portal::';
327
        my $db_type     = $type;
Yadd's avatar
Yadd committed
328
329
        my $db_name     = $self->{$db_type}
          or $self->abort("'$db_type' is not set");
330
331
332
333
334

        # Adapt module type to real module name
        $db_type =~ s/authentication/Auth/;
        $db_type =~ s/userDB/UserDB/;
        $db_type =~ s/passwordDB/PasswordDB/;
335
        $db_type =~ s/registerDB/RegisterDB/;
336
337
338
339
340
341
342
343

        # 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
344
345
        $self->abort( "Configuration error", "Unable to load $module_name" )
          unless $self->loadModule($module_name);
346
347
348

        # $self->{authentication} and $self->{userDB} can contains arguments
        # (key1 = scalar_value; key2 = ...)
349
350
351
        unless ( $db_name =~ /^Multi/ ) {
            $db_name =~ s/^\w+\s*//;
            my %h = split( /\s*[=;]\s*/, $db_name ) if ($db_name);
352
353
            %$self = ( %h, %$self );
        }
354
    }
355

Clément OUDOT's avatar
SAML:    
Clément OUDOT committed
356
    # Check issuerDB path to load the correct issuerDB module
357
    foreach my $issuerDBtype (qw(SAML OpenID CAS OpenIDConnect)) {
Clément OUDOT's avatar
SAML:    
Clément OUDOT committed
358
359
360
361
362
        my $module_name = 'Lemonldap::NG::Portal::IssuerDB' . $issuerDBtype;

        $self->lmLog( "[IssuerDB activation] Try issuerDB module $issuerDBtype",
            'debug' );

363
364
365
366
367
368
369
370
371
372
373
374
        # Check activation flag
        my $activation =
          $self->{ "issuerDB" . $issuerDBtype . "Activation" } ||= "0";

        unless ($activation) {
            $self->lmLog(
                "[IssuerDB activation] Activation flag set to off, trying next",
                'debug'
            );
            next;
        }

Clément OUDOT's avatar
SAML:    
Clément OUDOT committed
375
376
377
378
379
380
381
        # Check the path
        my $path = $self->{ "issuerDB" . $issuerDBtype . "Path" };
        if ( defined $path ) {
            $self->lmLog( "[IssuerDB activation] Found path $path", 'debug' );

            # Get current path
            my $url_path = $self->url( -absolute => 1 );
382
            $url_path =~ s#^//#/#;
Clément OUDOT's avatar
SAML:    
Clément OUDOT committed
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
            $self->lmLog(
                "[IssuerDB activation] Path of current request is $url_path",
                'debug' );

            # Match regular expression
            if ( $url_path =~ m#$path# ) {
                $self->abort( "Configuration error",
                    "Unable to load $module_name" )
                  unless $self->loadModule($module_name);

                # Remember loaded module
                $self->{_activeIssuerDB} = $issuerDBtype;
                $self->lmLog(
"[IssuerDB activation] IssuerDB module $issuerDBtype loaded",
                    'debug'
                );
                last;

            }
            else {
                $self->lmLog(
                    "[IssuerDB activation] Path do not match, trying next",
                    'debug' );
                next;
            }

        }
        else {
            $self->lmLog( "[IssuerDB activation] No path defined", 'debug' );
            next;
        }

    }

    # Load default issuerDB module if none was choosed
    unless ( $self->{_activeIssuerDB} ) {

        # Manage old configuration format
        my $db_type = $self->{'issuerDB'} || 'Null';

        my $module_name = 'Lemonldap::NG::Portal::IssuerDB' . $db_type;

        $self->abort( "Configuration error", "Unable to load $module_name" )
          unless $self->loadModule($module_name);

        # Remember loaded module
        $self->{_activeIssuerDB} = $db_type;
        $self->lmLog( "[IssuerDB activation] IssuerDB module $db_type loaded",
            'debug' );
    }

434
    # Notifications
435
    if ( $self->{notification} ) {
436
        require Lemonldap::NG::Common::Notification;
437
        my $tmp;
438
439

        # Use configuration options
440
        if ( $self->{notificationStorage} ) {
441
442
443
444
            $tmp->{type} = $self->{notificationStorage};
            foreach ( keys %{ $self->{notificationStorageOptions} } ) {
                $tmp->{$_} = $self->{notificationStorageOptions}->{$_};
            }
445
        }
446
447

        # Else use the configuration backend
448
        else {
Yadd's avatar
Yadd committed
449
            (%$tmp) = ( %{ $self->{lmConf} } );
450
451
452
            $self->abort( "notificationStorage not defined",
                "This parameter is required to use notification system" )
              unless ( ref($tmp) );
453
454

            # Get the type
Yadd's avatar
Yadd committed
455
            $tmp->{type} =~ s/.*:://;
456
            $tmp->{type} =~ s/(CDBI|RDBI)/DBI/;    # CDBI/RDBI are DBI
457

458
459
460
            # If type not File, DBI or LDAP, abort
            $self->abort("Only File, DBI or LDAP supported for Notifications")
              unless $tmp->{type} =~ /^(File|DBI|LDAP)$/;
461
462

            # Force table name
463
464
            $tmp->{table} = 'notifications';
        }
465

Yadd's avatar
Yadd committed
466
        $tmp->{p}            = $self;
467
468
        $self->{notifObject} = Lemonldap::NG::Common::Notification->new($tmp);
        $self->abort($Lemonldap::NG::Common::Notification::msg)
469
          unless ( $self->{notifObject} );
470
    }
471
472

    # SOAP
473
    if ( $self->{Soap} or $self->{soap} ) {
474
        $self->loadModule('Lemonldap::NG::Portal::_SOAP');
475
        if ( $self->{notification} and $ENV{PATH_INFO} ) {
476
            $self->{CustomSOAPServices} ||= {};
477
478
479
480
            $self->{CustomSOAPServices}->{'/notification'} = {
                f => 'newNotification deleteNotification',
                o => $self->{notifObject}
            };
Yadd's avatar
Yadd committed
481
        }
482
        $self->startSoapServices();
483
    }
484
485

    # Trusted domains
486
    $self->{trustedDomains} ||= "";
487
488
    $self->{trustedDomains} = "*"
      if ( $self->{trustedDomains} =~ /(^|\s)\*(\s|$)/ );
489
    if ( $self->{trustedDomains} and $self->{trustedDomains} ne "*" ) {
490
        $self->{trustedDomains} =~ s#(^|\s+)\.#${1}[^/]+.#g;
491
492
        $self->{trustedDomains} =
          '(' . join( '|', split( /\s+/, $self->{trustedDomains} ) ) . ')';
493
        $self->{trustedDomains} =~ s/\./\\./g;
494
    }
Yadd's avatar
Yadd committed
495

496
497
498
    return $self;
}

499
##@method boolean loadModule(string module, boolean ignoreError)
Clément OUDOT's avatar
Clément OUDOT committed
500
501
# Load a module into portal namespace
# @param module module name
502
# @param ignoreError set to 1 if error should not appear in logs
Clément OUDOT's avatar
Clément OUDOT committed
503
504
# @return boolean
sub loadModule {
Yadd's avatar
Yadd committed
505
    my ( $self, $module, $ignoreError ) = @_;
Clément OUDOT's avatar
Clément OUDOT committed
506
507
508
509
510
511

    return 1 unless $module;

    # Load module test
    eval "require $module";
    if ($@) {
512
        $self->lmLog( "$module load error: $@", 'error' ) unless $ignoreError;
Clément OUDOT's avatar
Clément OUDOT committed
513
514
515
516
517
        return 0;
    }

    # Push module in @ISA
    push @ISA, $module;
518
519
520

    $self->lmLog( "Module $module loaded", 'debug' );

Clément OUDOT's avatar
Clément OUDOT committed
521
522
523
    return 1;
}

524
##@method protected boolean getConf(hashRef args)
Yadd's avatar
Yadd committed
525
# Copy all parameters in caller object.
526
#@param args hash-ref
Yadd's avatar
Yadd committed
527
#@return True
528
529
530
531
532
533
534
535
536
537
538
539
540
sub getConf {
    my ($self) = shift;
    my %args;
    if ( ref( $_[0] ) ) {
        %args = %{ $_[0] };
    }
    else {
        %args = @_;
    }
    %$self = ( %$self, %args );
    1;
}

541
## @method protected void setHiddenFormValue(string fieldname, string value, string prefix, boolean base64)
542
543
# Add element into $self->{portalHiddenFormValues}, those values could be
# used to hide values into HTML form.
544
545
546
547
548
# @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
549
sub setHiddenFormValue {
Yadd's avatar
Yadd committed
550
    my ( $self, $key, $val, $prefix, $base64 ) = @_;
551
552
553
554
555
556

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

    # Store value
557
    if ($val) {
558
559
560
        $key = $prefix . $key;
        $val = encode_base64($val) if $base64;
        $self->{portalHiddenFormValues}->{$key} = $val;
561
        $self->lmLog( "Store $val in hidden key $key", 'debug' );
562
    }
563
564
}

565
## @method public void getHiddenFormValue(string fieldname, string prefix, boolean base64)
566
# Get value into $self->{portalHiddenFormValues}.
567
568
569
570
# @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
571
sub getHiddenFormValue {
Yadd's avatar
Yadd committed
572
    my ( $self, $key, $prefix, $base64 ) = @_;
573
574
575
576
577
578
579
580

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

    $key = $prefix . $key;

    # Get value
581
    if ( my $val = $self->param($key) ) {
582
583
        $val = decode_base64($val) if $base64;
        return $val;
584
        $self->lmLog( "Hidden value $val found for key $key", 'debug' );
585
    }
586
587

    # No value found
588
    return undef;
589
590
}

591
592
593
594
595
## @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
596
sub clearHiddenFormValue {
Yadd's avatar
Yadd committed
597
    my ( $self, $keys ) = @_;
598
599
600

    unless ( defined $keys ) {
        delete $self->{portalHiddenFormValues};
601
        $self->lmLog( "Delete all hidden values", 'debug' );
602
603
    }
    else {
604
605
606
607
        foreach (@$keys) {
            delete $self->{portalHiddenFormValues}->{$_};
            $self->lmLog( "Delete hidden value for key $_", 'debug' );
        }
608
609
610
611
612
    }

    return;
}

613
614
##@method public string buildHiddenForm()
# Return an HTML representation of hidden values.
615
# @return HTML code
616
617
sub buildHiddenForm {
    my $self = shift;
618
    my @keys = keys %{ $self->{portalHiddenFormValues} };
Clément OUDOT's avatar
   
Clément OUDOT committed
619
    my $val  = '';
620

621
    foreach (@keys) {
622
623

        # Check XSS attacks
Clément OUDOT's avatar
   
Clément OUDOT committed
624
625
        next
          if $self->checkXSSAttack( $_, $self->{portalHiddenFormValues}->{$_} );
626
627

        # Build hidden input HTML code
Yadd's avatar
Yadd committed
628
        $val .= qq{<input type="hidden" name="$_" id="$_" value="}
629
          . $self->{portalHiddenFormValues}->{$_} . '" />';
630
    }
631

632
633
634
    return $val;
}

635
## @method void initCaptcha(void)
636
# init captcha module and generate captcha
637
# @return nothing
638
639
sub initCaptcha {
    my $self = shift;
640

641
642
643
644
645
646
647
    # Create new captcha
    my $captcha = Lemonldap::NG::Common::Captcha->new(
        {
            storageModule        => $self->{captchaStorage},
            storageModuleOptions => $self->{captchaStorageOptions},
            size                 => $self->{captcha_size},
        }
Yadd's avatar
Yadd committed
648
    );
649

650
    $self->{captcha_secret} = $captcha->code;
651
    $self->{captcha_code}   = $captcha->md5;
652
    $self->{captcha_img} = $self->{portal} . "?displayCaptcha=" . $captcha->md5;
653

654
655
656
    $self->lmLog( "Captcha code generated: " . $self->{captcha_code}, 'debug' );

    return;
657
658
}

659
660
661
662
663
664
## @method int checkCaptcha(code, ccode)
# Check captcha auth
# @param code that user enter in the form
# @param captcha code generated by Authen::Captcha
# @return a constant
sub checkCaptcha {
Yadd's avatar
Yadd committed
665
    my ( $self, $code, $ccode ) = @_;
666

667
    # Get captcha object
668
669
670
671
672
673
674
675
676
    my $captcha = Lemonldap::NG::Common::Captcha->new(
        {
            storageModule        => $self->{captchaStorage},
            storageModuleOptions => $self->{captchaStorageOptions},
            md5                  => $ccode,
            size                 => $self->{captcha_size},
        }
    );

677
    # Check code
678
679
680
681
682
683
684
685
686
687
688
689
    if ( $captcha && $captcha->code ) {

        if ( $code eq $captcha->code ) {
            $self->lmLog( "Code $code match captcha $ccode", 'debug' );
            return 1;
        }
        return -2;
    }

    return 0;
}

690
691
692
693
694
## @method int removeCaptcha(ccode)
# Remove captcha session
# @param captcha code generated by Authen::Captcha
# @return a constant
sub removeCaptcha {
Yadd's avatar
Yadd committed
695
    my ( $self, $ccode ) = @_;
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717

    # Get captcha object
    my $captcha = Lemonldap::NG::Common::Captcha->new(
        {
            storageModule        => $self->{captchaStorage},
            storageModuleOptions => $self->{captchaStorageOptions},
            md5                  => $ccode,
            size                 => $self->{captcha_size},
        }
    );

    # Remove captcha session (will not be used anymore)
    if ( $captcha->removeSession ) {
        $self->lmLog( "Captcha session $ccode removed", 'debug' );
        return 0;
    }
    else {
        $self->lmLog( "Unable to remove captcha session $ccode", 'warn' );
        return 1;
    }
}

718
719
720
721
722
723
## @method boolean isTrustedUrl(string url)
# Check if an URL's domain name is declared in LL::NG config or is declared as trusted domain
# @param url Parameter url
# @param value Parameter value
# @return 1 if url can be trusted, 0 else
sub isTrustedUrl {
Yadd's avatar
Yadd committed
724
    my ( $self, $url ) = @_;
725
    return
726
727
728
729
         $url =~ m#^https?://$self->{reVHosts}(:\d+)?/#o
      || $self->{trustedDomains} eq "*"
      || $self->{trustedDomains}
      && $url =~ m#^https?://$self->{trustedDomains}(:\d+)?/#o;
730
731
}

Clément OUDOT's avatar
   
Clément OUDOT committed
732
733
734
735
736
737
## @method boolean checkXSSAttack(string name, string value)
# Check value to detect XSS attack
# @param name Parameter name
# @param value Parameter value
# @return 1 if attack detected, 0 else
sub checkXSSAttack {
Yadd's avatar
Yadd committed
738
    my ( $self, $name, $value ) = @_;
Clément OUDOT's avatar
   
Clément OUDOT committed
739

740
741
742
743
    # Empty values are not bad
    return 0 unless $value;

    # Test value
Clément OUDOT's avatar
   
Clément OUDOT committed
744
745
746
    if ( $value =~ m/(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/ ) {
        $self->lmLog( "XSS attack detected (param: $name | value: $value)",
            "warn" );
Clément OUDOT's avatar
Clément OUDOT committed
747
        return $self->{checkXSS};
Clément OUDOT's avatar
   
Clément OUDOT committed
748
749
750
751
752
    }

    return 0;
}

753
754
755
756
757
758
759
760
761
762
=begin WSDL

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

=end WSDL

=cut

763
764
765
766
767
768
769
##@method string msg(int code)
# calls Portal/_i18n.pm to display message in the client's language.
#@param $code message code
#@return message
sub msg {
    my $self = shift;
    my $code = shift;
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
    my $msg;

    # Check for customized message
    foreach ( @{ $self->{lang} } ) {
        if ( $self->{ "msg_" . $_ . "_" . $code } ) {
            $msg = $self->{ "msg_" . $_ . "_" . $code };
            last;
        }
    }
    $msg ||= $self->{ "msg_" . $code };

    # Use customized message or built-in message
    if ( defined $msg ) {

        # Manage UTF-8
        utf8::decode($msg);

        $self->lmLog( "Use customized message $msg for message $code",
            'debug' );
    }
    else {
        $msg = &Lemonldap::NG::Portal::_i18n::msg( $code, $self->{lang} );
    }

    return $msg;
795
796
797
798
}

##@method string error(int code)
# calls Portal/_i18n.pm to display error in the client's language.
799
#@param $code optional error code
800
#@return error message
801
802
sub error {
    my $self = shift;
803
    my $code = shift || $self->{error};
804
    if ( my $lang = shift ) {    # only for SOAP error requests
805
806
        $self->{lang} = $self->extract_lang($lang);
    }
807
808
809
    my $msg;

    # Check for customized message
Clément OUDOT's avatar
Clément OUDOT committed
810
    foreach ( @{ $self->{lang} } ) {
811
812
813
814
815
816
        if ( $self->{ "error_" . $_ . "_" . $code } ) {
            $msg = $self->{ "error_" . $_ . "_" . $code };
            last;
        }
    }
    $msg ||= $self->{ "error_" . $code };
817
818

    # Use customized message or built-in message
819
    if ( defined $msg ) {
820
821
822
823
824

        # Manage UTF-8
        utf8::decode($msg);

        $self->lmLog( "Use customized message $msg for error $code", 'debug' );
825
826
    }
    else {
Clément OUDOT's avatar
Clément OUDOT committed
827
        $msg = &Lemonldap::NG::Portal::_i18n::error( $code, $self->{lang} );
828
829
    }

830
    return $msg;
831
832
}

833
##@method string error_type(int code)
834
# error_type tells if error is positive, warning or negative
Yadd's avatar
Yadd committed
835
836
# @param $code Lemonldap::NG error code
# @return "positive", "warning" or "negative"
837
838
sub error_type {
    my $self = shift;
Yadd's avatar
Yadd committed
839
    my $code = shift || $self->{error};
840
841

    # Positive errors
842
843
844
    return "positive"
      if (
        scalar(
845
            grep { /^$code$/ } (
846
847
848
849
                PE_REDIRECT,        PE_DONE,
                PE_OK,              PE_PASSWORD_OK,
                PE_MAILOK,          PE_LOGOUT_OK,
                PE_MAILFIRSTACCESS, PE_PASSWORDFIRSTACCESS,
850
                PE_MAILCONFIRMOK,   PE_REGISTERFIRSTACCESS,
851
            )
852
853
        )
      );
854
855

    # Warning errors
856
857
858
    return "warning"
      if (
        scalar(
Yadd's avatar
Yadd committed
859
            grep { /^$code$/ } (
860
861
862
863
864
865
                PE_INFO,                          PE_SESSIONEXPIRED,
                PE_FORMEMPTY,                     PE_FIRSTACCESS,
                PE_PP_GRACE,                      PE_PP_EXP_WARNING,
                PE_NOTIFICATION,                  PE_BADURL,
                PE_CONFIRM,                       PE_MAILFORMEMPTY,
                PE_MAILCONFIRMATION_ALREADY_SENT, PE_PASSWORDFORMEMPTY,
866
                PE_CAPTCHAEMPTY,                  PE_REGISTERFORMEMPTY,
867
868
869
            )
        )
      );
870
871
872
873
874

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

Yadd's avatar
Yadd committed
875
##@method void header()
876
# Overload CGI::header() to add Lemonldap::NG cookie.
877
878
sub header {
    my $self = shift;
879
    unshift @_, '-type' unless ($#_);
880
881
882
883
884
885
886
887
    if ( $self->{cookie} ) {
        $self->SUPER::header( @_, -cookie => $self->{cookie} );
    }
    else {
        $self->SUPER::header(@_);
    }
}

Yadd's avatar
Yadd committed
888
##@method void redirect()
889
# Overload CGI::redirect() to add Lemonldap::NG cookie.
890
891
sub redirect {
    my $self = shift;
892
893
    if ( $self->{cookie} ) {
        $self->SUPER::redirect( @_, -cookie => $self->{cookie} );
894
895
896
897
898
899
    }
    else {
        $self->SUPER::redirect(@_);
    }
}

900
## @method protected hashref getApacheSession(string id, boolean noInfo, boolean $force)
Yadd's avatar
Yadd committed
901
# Try to recover the session corresponding to id and return session datas.
902
# If $id is set to undef or if $force is true, return a new session.
Clément OUDOT's avatar
   
Clément OUDOT committed
903
904
# @param id session reference
# @param noInfo do not set Apache REMOTE_USER
905
# @param force Force session creation if it does not exist
906
# return Lemonldap::NG::Common::Session object
907
sub getApacheSession {
908
    my ( $self, $id, $noInfo, $force ) = @_;
909

910
911
912
913
914
915
916
    my $apacheSession = Lemonldap::NG::Common::Session->new(
        {
            storageModule        => $self->{globalStorage},
            storageModuleOptions => $self->{globalStorageOptions},
            cacheModule          => $self->{localSessionStorage},
            cacheModuleOptions   => $self->{localSessionStorageOptions},
            id                   => $id,
917
            force                => $force,
918
            kind                 => "SSO",
919
        }
920
921
    );

922
923
924
925
    if ( $apacheSession->error ) {
        $self->lmLog( $apacheSession->error, 'debug' );
        return;
    }
926

927
928
929
930
931
    if ( $id and !$force and !$apacheSession->data ) {
        $self->lmLog( "Session $id not found", 'debug' );
        return;
    }

932
    unless ($noInfo) {
933
934
935
        $self->setApacheUser( $apacheSession->data->{ $self->{whatToTrace} } )
          if ($id);
        $self->{id} = $apacheSession->id;
936
    }
937
    return $apacheSession;
938
939
}

940
941
942
## @method protected hashref getPersistentSession(string uid)
# Try to recover the persistent session corresponding to uid and return session datas.
# @param uid main user identifier (whatToTrace)
943
# return Lemonldap::NG::Common::Session object
944
sub getPersistentSession {
945
946
947
948
949
950
    my ( $self, $uid ) = @_;

    return unless defined $uid;

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

952
953
954
955
956
957
    my $persistentSession = Lemonldap::NG::Common::Session->new(
        {
            storageModule        => $self->{persistentStorage},
            storageModuleOptions => $self->{persistentStorageOptions},
            cacheModule          => $self->{localSessionStorage},
            cacheModuleOptions   => $self->{localSessionStorageOptions},
958
            id                   => $pid,
959
960
            force                => 1,
            kind                 => "Persistent",
961
        }
962
963
    );

964
965
966
967
    if ( $persistentSession->error ) {
        $self->lmLog( $persistentSession->error, 'debug' );
    }

968
969
970
971
972
    # Set _session_uid if not already present
    unless ( defined $persistentSession->data->{_session_uid} ) {
        $persistentSession->update( { '_session_uid' => $uid } );
    }

973
974
975
976
977
    # Set _utime if not already present
    unless ( defined $persistentSession->data->{_utime} ) {
        $persistentSession->update( { '_utime' => time } );
    }

978
    return $persistentSession;
979
980
}

Yadd's avatar
Yadd committed
981
982
983
984
985
## @method protected string _md5hash(string s)
# Return md5(s)
# @param $s String to hash
# @return hashed value
sub _md5hash {
Yadd's avatar
Yadd committed
986
    my ( $self, $s ) = @_;
Yadd's avatar
Yadd committed
987
988
989
    return substr( Digest::MD5::md5_hex($s), 0, 32 );
}

990
## @method void updatePersistentSession(hashRef infos, string uid, string id)
Yadd's avatar
Yadd committed
991
992
993
994
# 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
995
996
# @param uid optional Unhashed persistent session ID
# @param id optional SSO session ID
Yadd's avatar
Yadd committed
997
998
# @return nothing
sub updatePersistentSession {
Yadd's avatar
Yadd committed
999
    my ( $self, $infos, $uid, $id ) = @_;
Yadd's avatar
Yadd committed
1000
1001

    # Return if no infos to update
Yadd's avatar
Yadd committed
1002
    return () unless ( ref $infos eq 'HASH' and %$infos );
Yadd's avatar
Yadd committed
1003

1004
    # Update current session
Clément OUDOT's avatar
   
Clément OUDOT committed
1005
    $self->updateSession( $infos, $id );
Yadd's avatar
Yadd committed
1006

Yadd's avatar
Yadd committed
1007
1008
1009
    $uid ||= $self->{sessionInfo}->{ $self->{whatToTrace} };
    return () unless ($uid);

1010
    my $persistentSession = $self->getPersistentSession($uid);
1011
1012

    $persistentSession->update($infos);
1013
1014
1015
1016
1017
1018
1019
1020

    if ( $persistentSession->error ) {
        $self->lmLog(
            "Cannot update persistent session " . $self->_md5hash($uid),
            'error' );
        $self->lmLog( $persistentSession->error, 'error' );
    }

Yadd's avatar
Yadd committed
1021
1022
}

1023
## @method void updateSession(hashRef infos, string id)
1024
# Update session stored.
1025
1026
# If no id is given, try to get it from cookie.
# If the session is available, update datas with $info.
1027
1028
# Note that outdated session data may remain some time on
# server local cache, if there are several LL::NG servers.
Yadd's avatar
Yadd committed
1029
# @param infos hash reference of information to update
1030
1031
# @param id Session ID
# @return nothing
1032
sub updateSession {
Yadd's avatar
Yadd committed
1033
    my ( $self, $infos, $id ) = @_;
1034

Clément OUDOT's avatar
Clément OUDOT committed
1035
    # Return if no infos to update
Yadd's avatar
Yadd committed
1036
    return () unless ( ref $infos eq 'HASH' and %$infos );
Clément OUDOT's avatar