Run.pm 24.6 KB
Newer Older
1
# Main running methods file
2 3
package Lemonldap::NG::Handler::Main::Run;

4 5 6 7
our $VERSION = '2.0.0';

package Lemonldap::NG::Handler::Main;

8 9 10 11 12 13 14
use strict;

#use AutoLoader 'AUTOLOAD';
use MIME::Base64;
use URI::Escape;
use Lemonldap::NG::Common::Session;

15
# Methods that must be overloaded
16 17 18

sub handler {
    die "Must be overloaded" unless ($#_);
Xavier Guimard's avatar
Xavier Guimard committed
19 20
    my ($res) = $_[0]->run( $_[1] );
    return $res;
21 22 23 24 25
}

sub logout {
    my $class;
    $class = $#_ ? shift : __PACKAGE__;
26
    return $class->unlog(@_);
27 28 29 30 31
}

sub status {
    my $class;
    $class = $#_ ? shift : __PACKAGE__;
32
    return $class->getStatus(@_);
33 34 35 36
}

# Public methods

37
# Return Handler::Lib::Status output
38
sub getStatus {
39
    my ( $class, $req ) = @_;
40
    $class->logger->debug("Request for status");
41 42
    my $statusPipe = $class->tsv->{statusPipe};
    my $statusOut  = $class->tsv->{statusOut};
43 44 45 46
    my $args       = '';
    if ( $ENV{LLNGSTATUSHOST} ) {
        require IO::Socket::INET;
        foreach ( 64322 .. 64331 ) {
Xavier Guimard's avatar
Xavier Guimard committed
47 48
            if ( $statusOut =
                IO::Socket::INET->new( Proto => 'udp', LocalPort => $_ ) )
49
            {
Xavier Guimard's avatar
Xavier Guimard committed
50 51
                $args =
                  ' host=' . ( $ENV{LLNGSTATUSCLIENT} || 'localhost' ) . ":$_";
52 53 54 55
                last;
            }
        }
        return $class->abort( $req,
Xavier Guimard's avatar
Xavier Guimard committed
56 57
            "$class: status page can not be displayed, unable to open socket" )
          unless ($statusOut);
58
    }
59
    return $class->abort( $req, "$class: status page can not be displayed" )
Xavier Guimard's avatar
Xavier Guimard committed
60
      unless ( $statusPipe and $statusOut );
Xavier Guimard's avatar
Xavier Guimard committed
61 62 63 64 65
    my $q = $req->{env}->{QUERY_STRING} || '';
    if ( $q =~ /\s/ ) {
        $class->logger->error("Bad characters in query");
        return $class->FORBIDDEN;
    }
66
    $statusPipe->print(
67
        "STATUS " . ( $req->{env}->{QUERY_STRING} || '' ) . "$args\n" );
68 69
    my $buf;

70
    while ( $_ = $statusOut->getline ) {
71 72 73
        last if (/^END$/);
        $buf .= $_;
    }
74 75 76
    $class->set_header_out( $req,
        "Content-Type" => "text/html; charset=UTF-8" );
    $class->print( $req, $buf );
77 78 79
    return $class->OK;
}

80 81
# Method that must be called by base packages (Handler::ApacheMP2,...) to get
# type of handler to call (Main, AuthBasic,...)
82 83 84 85 86
sub checkType {
    my ( $class, $req ) = @_;

    if ( time() - $class->lastCheck > $class->checkTime ) {
        die("$class: No configuration found")
Xavier Guimard's avatar
Xavier Guimard committed
87
          unless ( $class->checkConf );
88
    }
89
    my $vhost = $class->resolveAlias($req);
90
    return ( defined $class->tsv->{type}->{$vhost} )
Xavier Guimard's avatar
Xavier Guimard committed
91 92
      ? $class->tsv->{type}->{$vhost}
      : 'Main';
93 94
}

95 96 97 98 99 100 101 102 103
## @rmethod int run
# Check configuration and launch Lemonldap::NG::Handler::Main::run().
# Each $checkTime, the Apache child verify if its configuration is the same
# as the configuration stored in the local storage.
# @param $rule optional Perl expression to grant access
# @return Apache constant

sub run {
    my ( $class, $req, $rule, $protection ) = @_;
104 105
    my ( $id, $session );

106
    return $class->DECLINED unless ( $class->is_initial_req($req) );
107

Christophe Maudoux's avatar
Christophe Maudoux committed
108
    # Direct return if maintenance mode is enabled
109
    if ( $class->checkMaintenanceMode($req) ) {
110 111

        if ( $class->tsv->{useRedirectOnError} ) {
112
            $class->logger->debug("Go to portal with maintenance error code");
113
            return $class->goToError( $req, '/', $class->MAINTENANCE );
114 115
        }
        else {
116
            $class->logger->debug("Return maintenance error code");
117 118 119 120 121
            return $class->MAINTENANCE;
        }
    }

    # Cross domain authentication
122
    my $uri = $req->{env}->{REQUEST_URI};
123

124
    $uri = $req->{env}->{REQUEST_URI};
125 126
    my ($cond);
    ( $cond, $protection ) = $class->conditionSub($rule) if ($rule);
127
    $protection = $class->isUnprotected( $req, $uri ) || 0
Xavier Guimard's avatar
Xavier Guimard committed
128
      unless ( defined $protection );
129 130

    if ( $protection == $class->SKIP ) {
131
        $class->logger->debug("Access control skipped");
132 133 134
        $class->updateStatus( $req, 'SKIP' );
        $class->hideCookie($req);
        $class->cleanHeaders($req);
135 136 137 138
        return $class->OK;
    }

    # Try to recover cookie and user session
139 140
    if (    $id = $class->fetchId($req)
        and $session = $class->retrieveSession( $req, $id ) )
141
    {
142 143 144 145

        # AUTHENTICATION done

        # Local macros
Xavier Guimard's avatar
Xavier Guimard committed
146
        my $kc = keys %{$session};    # in order to detect new local macro
147 148

        # ACCOUNTING (1. Inform web server)
149
        $class->set_user( $req, $session->{ $class->tsv->{whatToTrace} } );
150 151

        # AUTHORIZATION
152
        return ( $class->forbidden( $req, $session ), $session )
Xavier Guimard's avatar
Xavier Guimard committed
153
          unless ( $class->grant( $req, $session, $uri, $cond ) );
154 155
        $class->updateStatus( $req, 'OK',
            $session->{ $class->tsv->{whatToTrace} } );
156 157

        # ACCOUNTING (2. Inform remote application)
158
        $class->sendHeaders( $req, $session );
159 160

        # Store local macros
Xavier Guimard's avatar
Xavier Guimard committed
161
        if ( keys %$session > $kc ) {
162
            $class->logger->debug("Update local cache");
Xavier Guimard's avatar
Xavier Guimard committed
163
            $req->data->{session}->update( $session, { updateCache => 2 } );
164 165 166
        }

        # Hide Lemonldap::NG cookie
167
        $class->hideCookie($req);
168 169

        # Log access granted
170
        $class->logger->debug( "User "
Xavier Guimard's avatar
Xavier Guimard committed
171 172
              . $session->{ $class->tsv->{whatToTrace} }
              . " was granted to access to $uri" );
173 174

        #  Catch POST rules
175 176
        $class->postOutputFilter( $req, $session, $uri );
        $class->postInputFilter( $req, $session, $uri );
177

Xavier Guimard's avatar
Xavier Guimard committed
178
        return ( $class->OK, $session );
179 180 181 182 183
    }

    elsif ( $protection == $class->UNPROTECT ) {

        # Ignore unprotected URIs
184
        $class->logger->debug("No valid session but unprotected access");
185 186 187
        $class->updateStatus( $req, 'UNPROTECT' );
        $class->hideCookie($req);
        $class->cleanHeaders($req);
188 189 190 191 192 193
        return $class->OK;
    }

    else {

        # Redirect user to the portal
194
        $class->logger->info("No cookie found")
Xavier Guimard's avatar
Xavier Guimard committed
195
          unless ($id);
196 197

        # if the cookie was fetched, a log is sent by retrieveSession()
198 199
        $class->updateStatus( $req, $id ? 'EXPIRED' : 'REDIRECT' );
        return $class->goToPortal( $req, $req->{env}->{REQUEST_URI} );
200 201 202
    }
}

203 204 205 206
## @rmethod protected int unlog()
# Call localUnlog() then goToPortal() to unlog the current user.
# @return Constant value returned by goToPortal()
sub unlog {
207 208 209 210
    my ( $class, $req ) = @_;
    $class->localUnlog( $req, @_ );
    $class->updateStatus( $req, 'LOGOUT' );
    return $class->goToPortal( $req, '/', 'logout=1' );
211 212
}

213 214 215 216 217 218 219 220
# INTERNAL METHODS

## @rmethod protected void updateStatus(string action,string user,string url)
# Inform the status process of the result of the request if it is available
# @param action string Result of access control (as $class->OK, $class->SKIP, LOGOUT...)
# @param optional user string Username to log, if undefined defaults to remote IP
# @param optional url string URL to log, if undefined defaults to request URI
sub updateStatus {
221
    my ( $class, $req, $action, $user, $url ) = @_;
222
    my $statusPipe = $class->tsv->{statusPipe} or return;
223 224
    $user ||= $req->{env}->{REMOTE_ADDR};
    $url  ||= $req->{env}->{REQUEST_URI};
225
    eval {
226 227
        $statusPipe->print(
            "$user => " . $req->{env}->{HTTP_HOST} . "$url $action\n" );
228 229 230 231 232 233 234 235 236
    };
}

## @rmethod void lmLog(string msg, string level)
# Wrapper for Apache log system
# @param $msg message to log
# @param $level string (emerg|alert|crit|error|warn|notice|info|debug)
sub lmLog {
    my ( $class, $msg, $level ) = @_;
237
    return $class->logger->$level($msg);
238 239 240 241
}

## @rmethod protected boolean checkMaintenanceMode
# Check if we are in maintenance mode
Christophe Maudoux's avatar
Christophe Maudoux committed
242
# @return true if maintenance mode is enabled
243
sub checkMaintenanceMode {
244 245
    my ( $class, $req ) = @_;
    my $vhost = $class->resolveAlias($req);
Xavier Guimard's avatar
Xavier Guimard committed
246 247 248 249
    my $_maintenance =
      ( defined $class->tsv->{maintenance}->{$vhost} )
      ? $class->tsv->{maintenance}->{$vhost}
      : $class->tsv->{maintenance}->{_};
250 251

    if ($_maintenance) {
Christophe Maudoux's avatar
Christophe Maudoux committed
252
        $class->logger->debug("Maintenance mode enabled");
253 254 255 256 257 258 259 260 261 262 263
        return 1;
    }
    return 0;
}

## @rmethod boolean grant(string uri, string cond)
# Grant or refuse client using compiled regexp and functions
# @param $uri URI
# @param $cond optional Function granting access
# @return True if the user is granted to access to the current URL
sub grant {
264 265
    my ( $class, $req, $session, $uri, $cond, $vhost ) = @_;
    return $cond->( $req, $session ) if ($cond);
266

267
    $vhost ||= $class->resolveAlias($req);
268 269 270 271 272 273
    if ( my $level = $class->tsv->{authnLevel}->{$vhost} ) {
        if ( $session->{authenticationLevel} < $level ) {
            $session->{_upgrade} = 1;
            return 0;
        }
    }
Xavier Guimard's avatar
Xavier Guimard committed
274
    for (
Xavier Guimard's avatar
Xavier Guimard committed
275 276
        my $i = 0 ;
        $i < ( $class->tsv->{locationCount}->{$vhost} || 0 ) ;
Xavier Guimard's avatar
Xavier Guimard committed
277
        $i++
Xavier Guimard's avatar
Xavier Guimard committed
278
      )
Xavier Guimard's avatar
Xavier Guimard committed
279
    {
280
        if ( $uri =~ $class->tsv->{locationRegexp}->{$vhost}->[$i] ) {
281
            $class->logger->debug( 'Regexp "'
Xavier Guimard's avatar
Xavier Guimard committed
282 283
                  . $class->tsv->{locationConditionText}->{$vhost}->[$i]
                  . '" match' );
284
            return $class->tsv->{locationCondition}->{$vhost}->[$i]
Xavier Guimard's avatar
Xavier Guimard committed
285
              ->( $req, $session );
286 287 288
        }
    }
    unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
289 290
        $class->logger->warn(
            "User rejected because VirtualHost \"$vhost\" has no configuration"
291 292 293
        );
        return 0;
    }
294
    $class->logger->debug("$vhost: Apply default rule");
295
    return $class->tsv->{defaultCondition}->{$vhost}->( $req, $session );
296 297 298 299
}

## @rmethod protected int forbidden(string uri)
# Used to reject non authorized requests.
Christophe Maudoux's avatar
Christophe Maudoux committed
300
# Inform the status process and call logForbidden().
301 302 303
# @param $uri URI
# @return Constant $class->FORBIDDEN
sub forbidden {
304 305 306
    my ( $class, $req, $session, $vhost ) = @_;
    my $uri = $req->{env}->{REQUEST_URI};
    $vhost ||= $class->resolveAlias($req);
307

Xavier Guimard's avatar
Xavier Guimard committed
308
    if ( $session->{_logout} ) {
309
        $class->updateStatus( $req, 'LOGOUT',
Xavier Guimard's avatar
Xavier Guimard committed
310 311
            $session->{ $class->tsv->{whatToTrace} } );
        my $u = $session->{_logout};
312 313
        $class->localUnlog($req);
        return $class->goToPortal( $req, $u, 'logout=1' );
314 315
    }

316
    if ( $session->{_upgrade} ) {
317
        return $class->goToPortal( $req, $uri, undef, '/upgradesession' );
318 319
    }

320
    # Log forbidding
321
    $class->userLogger->notice( "User "
Xavier Guimard's avatar
Xavier Guimard committed
322 323
          . $session->{ $class->tsv->{whatToTrace} }
          . " was forbidden to access to $vhost$uri" );
324 325
    $class->updateStatus( $req, 'REJECT',
        $session->{ $class->tsv->{whatToTrace} } );
326 327 328

    # Redirect or Forbidden?
    if ( $class->tsv->{useRedirectOnForbidden} ) {
329
        $class->logger->debug("Use redirect for forbidden access");
330
        return $class->goToError( $req, $uri, 403 );
331 332
    }
    else {
333
        $class->logger->debug("Return forbidden access");
334 335 336 337 338 339 340
        return $class->FORBIDDEN;
    }
}

## @rmethod protected void hideCookie()
# Hide Lemonldap::NG cookie to the protected application.
sub hideCookie {
341
    my ( $class, $req ) = @_;
342
    $class->logger->debug("removing cookie");
343
    my $cookie = $req->env->{HTTP_COOKIE};
344 345 346
    my $cn     = $class->tsv->{cookieName};
    $cookie =~ s/$cn(http)?=[^,;]*[,;\s]*//og;
    if ($cookie) {
347
        $class->set_header_in( $req, 'Cookie' => $cookie );
348 349
    }
    else {
350
        $class->unset_header_in( $req, 'Cookie' );
351 352 353 354
    }
}

## @rmethod protected string encodeUrl(string url)
Christophe Maudoux's avatar
Christophe Maudoux committed
355
# Encode URL in the format used by Lemonldap::NG::Portal for redirections.
356 357
# @return Base64 encoded string
sub encodeUrl {
358 359
    my ( $class, $req, $url ) = @_;
    $url = $class->_buildUrl( $req, $url ) if ( $url !~ m#^https?://# );
360 361 362 363 364 365 366 367 368
    return encode_base64( $url, '' );
}

## @rmethod protected int goToPortal(string url, string arg)
# Redirect non-authenticated users to the portal by setting "Location:" header.
# @param $url Url requested
# @param $arg optionnal GET parameters
# @return Constant $class->REDIRECT
sub goToPortal {
369
    my ( $class, $req, $url, $arg, $path ) = @_;
370
    $path ||= '';
371
    my ( $ret, $msg );
372
    my $urlc_init = $class->encodeUrl( $req, $url );
373
    $class->logger->debug(
374 375
        "Redirect $req->{env}->{REMOTE_ADDR} to portal (url was $url)");
    $class->set_header_out( $req,
Xavier Guimard's avatar
Xavier Guimard committed
376 377 378
            'Location' => $class->tsv->{portal}->()
          . "$path?url=$urlc_init"
          . ( $arg ? "&$arg" : "" ) );
379 380 381
    return $class->REDIRECT;
}

382
sub goToError {
383 384
    my ( $class, $req, $url, $code ) = @_;
    my $urlc_init = $class->encodeUrl( $req, $url );
385
    $class->logger->debug(
386 387
        "Redirect $req->{env}->{REMOTE_ADDR} to lmError (url was $url)");
    $class->set_header_out( $req,
Xavier Guimard's avatar
Xavier Guimard committed
388 389 390
            'Location' => $class->tsv->{portal}->()
          . "/lmerror/$code"
          . "?url=$urlc_init" );
391 392 393
    return $class->REDIRECT;
}

394 395 396 397
## @rmethod protected fetchId()
# Get user cookies and search for Lemonldap::NG cookie.
# @return Value of the cookie if found, 0 else
sub fetchId {
398 399 400
    my ( $class, $req ) = @_;
    my $t                 = $req->{env}->{HTTP_COOKIE} or return 0;
    my $vhost             = $class->resolveAlias($req);
401 402
    my $lookForHttpCookie = (
        $class->tsv->{securedCookie} =~ /^(2|3)$/
Xavier Guimard's avatar
Xavier Guimard committed
403
          and !( defined( $class->tsv->{https}->{$vhost} ) )
404 405
        ? $class->tsv->{https}->{$vhost}
        : $class->tsv->{https}->{_}
406
    );
407
    my $cn = $class->tsv->{cookieName};
Xavier Guimard's avatar
Xavier Guimard committed
408 409 410 411
    my $value =
      $lookForHttpCookie
      ? ( $t =~ /${cn}http=([^,; ]+)/o ? $1 : 0 )
      : ( $t =~ /$cn=([^,; ]+)/o ? $1 : 0 );
412

413 414 415 416 417 418
    if ( $value && $lookForHttpCookie && $class->tsv->{securedCookie} == 3 ) {
        $value = $class->tsv->{cipher}->decryptHex( $value, "http" );
    }
    elsif ( $value =~ s/^c:// ) {
        $value = $class->tsv->{cipher}->decrypt($value);
        unless ( $value =~ s/^(.*)? (.*)$/$1/ and $2 eq $vhost ) {
419 420
            $class->userLogger->error(
                "Bad CDA cookie: available for $2 instead od $vhost");
421 422 423
            return undef;
        }
    }
424 425 426 427 428 429 430
    return $value;
}

## @rmethod protected boolean retrieveSession(id)
# Tries to retrieve the session whose index is id
# @return true if the session was found, false else
sub retrieveSession {
431
    my ( $class, $req, $id ) = @_;
432 433 434 435
    my $now = time();

    # 1. Search if the user was the same as previous (very efficient in
    # persistent connection).
436 437
    # NB: timout is here the same value as current HTTP/1.1 Keep-Alive timeout
    #     (15 seconds)
Xavier Guimard's avatar
Xavier Guimard committed
438 439
    if (    defined $class->data->{_session_id}
        and $id eq $class->data->{_session_id}
Xavier Guimard's avatar
Xavier Guimard committed
440 441
        and ( $now - $class->dataUpdate < $class->tsv->{handlerInternalCache} )
      )
442
    {
443
        $class->logger->debug("Get session $id from Handler internal cache");
Xavier Guimard's avatar
Xavier Guimard committed
444
        return $class->data;
445 446 447
    }

    # 2. Get the session from cache or backend
Xavier Guimard's avatar
Xavier Guimard committed
448
    my $session = $req->data->{session} = (
449
        Lemonldap::NG::Common::Session->new(
Xavier Guimard's avatar
Xavier Guimard committed
450 451
            {
                storageModule        => $class->tsv->{sessionStorageModule},
452 453 454 455 456 457 458 459 460
                storageModuleOptions => $class->tsv->{sessionStorageOptions},
                cacheModule          => $class->tsv->{sessionCacheModule},
                cacheModuleOptions   => $class->tsv->{sessionCacheOptions},
                id                   => $id,
                kind                 => "SSO",
            }
        )
    );

Xavier Guimard's avatar
Xavier Guimard committed
461
    unless ( $session->error ) {
462

Xavier Guimard's avatar
Xavier Guimard committed
463
        $class->data( $session->data );
464
        $class->logger->debug("Get session $id from Handler::Main::Run");
465

466
        # Verify that session is valid
467
        $class->logger->error(
Xavier Guimard's avatar
Xavier Guimard committed
468
"_utime is not defined. This should not happen. Check if it is well transmitted to handler"
469
        ) unless $session->data->{_utime};
470

471
        $class->logger->debug("Check session validity from Handler");
Xavier Guimard's avatar
Xavier Guimard committed
472
        $class->logger->debug( "Session timeout -> " . $class->tsv->{timeout} );
473
        $class->logger->debug( "Session timeoutActivity -> "
Xavier Guimard's avatar
Xavier Guimard committed
474 475 476
              . $class->tsv->{timeoutActivity}
              . "s" )
          if ( $class->tsv->{timeoutActivity} );
477 478 479 480
        $class->logger->debug(
            "Session _utime -> " . $session->data->{_utime} );
        $class->logger->debug( "now -> " . $now );
        $class->logger->debug( "_lastSeen -> " . $session->data->{_lastSeen} )
Xavier Guimard's avatar
Xavier Guimard committed
481 482 483
          if ( $session->data->{_lastSeen} );
        my $delta = $now - $session->data->{_lastSeen}
          if ( $session->data->{_lastSeen} );
484
        $class->logger->debug( "now - _lastSeen = " . $delta )
Xavier Guimard's avatar
Xavier Guimard committed
485
          if ( $session->data->{_lastSeen} );
486
        $class->logger->debug( "Session timeoutActivityInterval -> "
Xavier Guimard's avatar
Xavier Guimard committed
487 488
              . $class->tsv->{timeoutActivityInterval} )
          if ( $class->tsv->{timeoutActivityInterval} );
489 490 491
        my $ttl = $class->tsv->{timeout} - $now + $session->data->{_utime};
        $class->logger->debug( "Session TTL = " . $ttl );

Xavier Guimard's avatar
Xavier Guimard committed
492 493
        if (
            $now - $session->data->{_utime} > $class->tsv->{timeout}
494 495
            or (    $class->tsv->{timeoutActivity}
                and $session->data->{_lastSeen}
496
                and $delta > $class->tsv->{timeoutActivity} )
Xavier Guimard's avatar
Xavier Guimard committed
497
          )
498 499 500 501
        {
            $class->logger->info("Session $id expired");

            # Clean cached data
Xavier Guimard's avatar
Xavier Guimard committed
502
            $class->data( {} );
503 504 505
            return 0;
        }

506
        # Update the session to notify activity, if necessary
Xavier Guimard's avatar
Xavier Guimard committed
507 508 509 510 511
        if (
            $class->tsv->{timeoutActivity}
            and ( $now - $session->data->{_lastSeen} >
                $class->tsv->{timeoutActivityInterval} )
          )
512 513 514 515 516 517 518 519 520 521 522 523 524
        {
            $req->data->{session}->update( { '_lastSeen' => $now } );
            $class->data( $session->data );

            if ( $session->error ) {
                $class->logger->error("Cannot update session $id");
                $class->logger->error( $req->data->{session}->error );
            }
            else {
                $class->logger->debug("Update _lastSeen with $now");
            }
        }

Xavier Guimard's avatar
Xavier Guimard committed
525
        $class->dataUpdate($now);
Xavier Guimard's avatar
Xavier Guimard committed
526
        return $session->data;
527 528
    }
    else {
529 530
        $class->logger->info("Session $id can't be retrieved");
        $class->logger->info( $session->error );
531 532 533 534 535 536 537 538 539 540

        return 0;
    }
}

## @cmethod private string _buildUrl(string s)
# Transform /<s> into http(s?)://<host>:<port>/s
# @param $s path
# @return URL
sub _buildUrl {
541
    my ( $class, $req, $s ) = @_;
542 543 544
    my $realvhost = $req->{env}->{HTTP_HOST};
    my $vhost     = $class->resolveAlias($req);
    my $_https    = (
545 546 547 548
        defined( $class->tsv->{https}->{$vhost} )
        ? $class->tsv->{https}->{$vhost}
        : $class->tsv->{https}->{_}
    );
Xavier Guimard's avatar
Xavier Guimard committed
549 550 551 552
    my $portString =
         $class->tsv->{port}->{$vhost}
      || $class->tsv->{port}->{_}
      || $req->{env}->{SERVER_PORT};
553
    $portString = (
Xavier Guimard's avatar
Xavier Guimard committed
554 555 556
             ( $realvhost =~ /:\d+/ )
          or ( $_https  && $portString == 443 )
          or ( !$_https && $portString == 80 )
557
    ) ? '' : ":$portString";
558
    my $url = "http" . ( $_https ? "s" : "" ) . "://$realvhost$portString$s";
559
    $class->logger->debug("Build URL $url");
560 561 562 563 564 565 566
    return $url;
}

## @rmethod protected int isUnprotected()
# @param $uri URI
# @return 0 if URI is protected,
# $class->UNPROTECT if it is unprotected by "unprotect",
Christophe Maudoux's avatar
Christophe Maudoux committed
567
# SKIP if unprotected by "skip"
568
sub isUnprotected {
569 570
    my ( $class, $req, $uri ) = @_;
    my $vhost = $class->resolveAlias($req);
Xavier Guimard's avatar
Xavier Guimard committed
571
    for (
Xavier Guimard's avatar
Xavier Guimard committed
572 573
        my $i = 0 ;
        $i < ( $class->tsv->{locationCount}->{$vhost} || 0 ) ;
Xavier Guimard's avatar
Xavier Guimard committed
574
        $i++
Xavier Guimard's avatar
Xavier Guimard committed
575
      )
Xavier Guimard's avatar
Xavier Guimard committed
576
    {
577 578 579 580 581 582 583 584 585 586
        if ( $uri =~ $class->tsv->{locationRegexp}->{$vhost}->[$i] ) {
            return $class->tsv->{locationProtection}->{$vhost}->[$i];
        }
    }
    return $class->tsv->{defaultProtection}->{$vhost};
}

## @rmethod void sendHeaders()
# Launch function compiled by forgeHeadersInit() for the current virtual host
sub sendHeaders {
587 588
    my ( $class, $req, $session ) = @_;
    my $vhost = $class->resolveAlias($req);
Xavier Guimard's avatar
Xavier Guimard committed
589
    if ( defined $class->tsv->{forgeHeaders}->{$vhost} ) {
590 591

        # Log headers in debug mode
Xavier Guimard's avatar
Xavier Guimard committed
592 593
        my %headers =
          $class->tsv->{forgeHeaders}->{$vhost}->( $req, $session );
Xavier Guimard's avatar
Xavier Guimard committed
594 595
        foreach my $h ( sort keys %headers ) {
            if ( defined( my $v = $headers{$h} ) ) {
596
                $class->logger->debug("Send header $h with value $v");
597 598
            }
            else {
599
                $class->logger->debug("Send header $h with empty value");
600 601
            }
        }
602
        $class->set_header_in( $req, %headers );
603 604 605 606 607 608
    }
}

## @rmethod void cleanHeaders()
# Unset HTTP headers, when sendHeaders is skipped
sub cleanHeaders {
609 610
    my ( $class, $req ) = @_;
    my $vhost = $class->resolveAlias($req);
611
    if ( defined( $class->tsv->{headerList}->{$vhost} ) ) {
612 613
        $class->unset_header_in( $req,
            @{ $class->tsv->{headerList}->{$vhost} } );
614 615 616 617 618 619
    }
}

## @rmethod string resolveAlias
# returns vhost whose current hostname is an alias
sub resolveAlias {
620
    my ( $class, $req ) = @_;
621
    my $vhost = ref $req ? $req->{env}->{HTTP_HOST} : $req;
Xavier Guimard's avatar
Xavier Guimard committed
622 623

    $vhost =~ s/:\d+//;
624
    return $class->tsv->{vhostAlias}->{$vhost}
Xavier Guimard's avatar
Xavier Guimard committed
625
      if ( $class->tsv->{vhostAlias}->{$vhost} );
626 627 628 629 630 631 632
    return $vhost if ( $class->tsv->{defaultCondition}->{$vhost} );
    my $v = $vhost;
    while ( $v =~ s/[\w\-]+/\*/ ) {
        return $v if ( $class->tsv->{defaultCondition}->{$v} );
        $v =~ s/^\*\.*//;
    }
    return $vhost;
633 634 635 636 637 638 639 640 641 642
}

#__END__

## @rmethod int abort(string msg)
# Logs message and exit or redirect to the portal if "useRedirectOnError" is
# set to true.
# @param $msg Message to log
# @return Constant ($class->REDIRECT, $class->SERVER_ERROR)
sub abort {
643
    my ( $class, $req, $msg ) = @_;
644 645 646

    # If abort is called without a valid request, fall to die
    eval {
647
        my $uri = $req->{env}->{REQUEST_URI};
648

649
        $class->logger->error($msg);
650 651 652

        # Redirect or die
        if ( $class->tsv->{useRedirectOnError} ) {
653
            $class->logger->debug("Use redirect for error");
654
            return $class->goToError( $req, $uri, 500 );
655 656 657 658 659 660 661 662 663 664 665
        }
        else {
            return $class->SERVER_ERROR;
        }
    };
    die $msg if ($@);
}

## @rmethod protected void localUnlog()
# Delete current user from local cache entry.
sub localUnlog {
666
    my ( $class, $req, $id ) = @_;
667
    $class->logger->debug('Local handler logout');
668
    if ( $id //= $class->fetchId($req) ) {
669

Xavier Guimard's avatar
Xavier Guimard committed
670 671 672
        # Delete thread data
        if (    $class->data->{_session_id}
            and $id eq $class->data->{_session_id} )
673
        {
Xavier Guimard's avatar
Xavier Guimard committed
674
            $class->data( {} );
675
        }
Xavier Guimard's avatar
Xavier Guimard committed
676
        delete $req->data->{session};
677 678 679 680 681 682 683 684 685 686 687 688 689 690

        # Delete local cache
        if (    $class->tsv->{refLocalStorage}
            and $class->tsv->{refLocalStorage}->get($id) )
        {
            $class->tsv->{refLocalStorage}->remove($id);
        }
    }
}

## @rmethod protected postOutputFilter(string uri)
# Add a javascript to html page in order to fill html form with fake data
# @param uri URI to catch
sub postOutputFilter {
691 692
    my ( $class, $req, $session, $uri ) = @_;
    my $vhost = $class->resolveAlias($req);
693 694

    if ( defined( $class->tsv->{outputPostData}->{$vhost}->{$uri} ) ) {
695
        $class->logger->debug("Filling a html form with fake data");
696

697
        $class->unset_header_in( $req, "Accept-Encoding" );
Xavier Guimard's avatar
Xavier Guimard committed
698 699
        my %postdata =
          $class->tsv->{outputPostData}->{$vhost}->{$uri}->( $req, $session );
700
        my $formParams = $class->tsv->{postFormParams}->{$vhost}->{$uri};
701 702
        my $js = $class->postJavascript( $req, \%postdata, $formParams );
        $class->addToHtmlHead( $req, $js );
703 704 705 706
    }
}

## @rmethod protected postInputFilter(string uri)
Xavier Guimard's avatar
Xavier Guimard committed
707
# Replace request body with form data defined in configuration
708 709
# @param uri URI to catch
sub postInputFilter {
710 711
    my ( $class, $req, $session, $uri ) = @_;
    my $vhost = $class->resolveAlias($req);
712 713

    if ( defined( $class->tsv->{inputPostData}->{$vhost}->{$uri} ) ) {
714
        $class->logger->debug("Replacing fake data with real form data");
715

Xavier Guimard's avatar
Xavier Guimard committed
716 717
        my %data =
          $class->tsv->{inputPostData}->{$vhost}->{$uri}->( $req, $session );
718 719 720
        foreach ( keys %data ) {
            $data{$_} = uri_escape( $data{$_} );
        }
721
        $class->setPostParams( $req, \%data );
722 723 724 725 726 727 728
    }
}

## @rmethod protected postJavascript(hashref data)
# build a javascript to fill a html form with fake data
# @param data hashref containing input => value
sub postJavascript {
729
    my ( $class, $req, $data, $formParams ) = @_;
730 731 732 733 734 735 736

    my $form = $formParams->{formSelector} || "form";

    my $filler;
    foreach my $name ( keys %$data ) {
        use bytes;
        my $value = "x" x bytes::length( $data->{$name} );
Xavier Guimard's avatar
Xavier Guimard committed
737 738
        $filler .=
"form.find('input[name=\"$name\"], select[name=\"$name\"], textarea[name=\"$name\"]').val('$value')\n";
739 740
    }

Xavier Guimard's avatar
Xavier Guimard committed
741 742 743 744 745
    my $submitter =
        $formParams->{buttonSelector} eq "none" ? ""
      : $formParams->{buttonSelector}
      ? "form.find('$formParams->{buttonSelector}').click();\n"
      : "form.submit();\n";
746 747

    my $jqueryUrl = $formParams->{jqueryUrl} || "";
Xavier Guimard's avatar
Xavier Guimard committed
748 749
    $jqueryUrl = &{ $class->tsv->{portal} } . "skins/common/js/jquery-1.10.2.js"
      if ( $jqueryUrl eq "default" );
750
    $jqueryUrl = "<script type='text/javascript' src='$jqueryUrl'></script>\n"
Xavier Guimard's avatar
Xavier Guimard committed
751
      if ($jqueryUrl);
752 753

    return
Xavier Guimard's avatar
Xavier Guimard committed
754 755 756 757 758 759 760 761 762
        $jqueryUrl
      . "<script type='text/javascript'>\n"
      . "/* script added by Lemonldap::NG */\n"
      . "jQuery(window).on('load', function() {\n"
      . "var form = jQuery('$form');\n"
      . "form.attr('autocomplete', 'off');\n"
      . $filler
      . $submitter . "})\n"
      . "</script>\n";
763 764 765
}

1;