Reload.pm 19.2 KB
Newer Older
1 2
package Lemonldap::NG::Handler::Main::Reload;

Xavier Guimard's avatar
Xavier Guimard committed
3
our $VERSION = '2.1.0';
4 5 6

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

7 8 9 10 11
use strict;
use Lemonldap::NG::Common::Conf::Constants;    #inherits
use Lemonldap::NG::Common::Crypto;
use Lemonldap::NG::Common::Safelib;            #link protected safe Safe object
use Lemonldap::NG::Handler::Main::Jail;
12
use Scalar::Util qw(weaken);
13 14 15 16

use constant UNPROTECT => 1;
use constant SKIP      => 2;

17
our @_onReload;
18

19 20 21 22
sub onReload {
    my ( $class, $obj, $sub ) = @_;
    weaken($obj);
    push @_onReload, [ $obj, $sub ];
23 24
}

25
# CONFIGURATION UPDATE
26

27 28 29 30 31 32 33 34 35
## @rmethod protected int checkConf(boolean force)
# Check if configuration is up to date, and reload it if needed.
# If the optional boolean $force is set to true,
# * cached configuration is ignored
# * and checkConf returns false if it fails to load remote config
# @param $force boolean
# @return true if config is up to date or if reload config succeeded
sub checkConf {
    my ( $class, $force ) = @_;
36
    $class->logger->debug("Check configuration for $class");
37
    my $prm  = { local => !$force, localPrm => $class->localConfig };
38
    my $conf = $class->confAcc->getConf($prm);
39
    chomp $Lemonldap::NG::Common::Conf::msg;
40 41

    unless ( ref($conf) ) {
42 43
        $class->logger->error(
"$class: Unable to load configuration: $Lemonldap::NG::Common::Conf::msg"
44 45 46 47
        );
        return $force ? 0 : $class->cfgNum ? 1 : 0;
    }

48 49 50 51 52 53 54 55 56 57 58
    if ($Lemonldap::NG::Common::Conf::msg) {
        if ( $Lemonldap::NG::Common::Conf::msg =~ /Error:/ ) {
            $class->logger->error($Lemonldap::NG::Common::Conf::msg);
        }
        elsif ( $Lemonldap::NG::Common::Conf::msg =~ /Warn:/ ) {
            $class->logger->warn($Lemonldap::NG::Common::Conf::msg);
        }
        else {
            $class->logger->debug($Lemonldap::NG::Common::Conf::msg);
        }
    }
59
    if ( $force or !$class->cfgNum or $class->cfgNum != $conf->{cfgNum} ) {
60
        $class->logger->debug("Get configuration $conf->{cfgNum}");
61
        unless ( $class->cfgNum( $conf->{cfgNum} ) ) {
62
            $class->logger->error('No configuration available');
63 64 65
            return 0;
        }
        $class->configReload($conf);
66 67 68 69 70 71 72 73 74
        foreach (@_onReload) {
            my ( $obj, $sub ) = @$_;
            if ($obj) {
                $class->logger->debug(
                    'Launching ' . ref($obj) . "->$sub(conf)" );
                unless ( $obj->$sub($conf) ) {
                    $class->logger->error( "Underlying object can't load conf ("
                          . ref($obj)
                          . "->$sub)" );
75
                    return 0;
76
                }
77 78
            }
        }
79
    }
80 81
    $class->tsv->{checkTime} = $conf->{checkTime} if ( $conf->{checkTime} );
    $class->lastCheck( time() );
82
    $class->logger->debug("$class: configuration is up to date");
83 84 85 86 87 88 89 90 91 92 93 94
    return 1;
}

# RELOAD SYSTEM

## @rmethod int reload
# Launch checkConf() with $local=0, so remote configuration is tested.
# Then build a simple HTTP response that just returns "200 OK" or
# "500 Server Error".
# @return Apache constant ($class->OK or $class->SERVER_ERROR)
sub reload {
    my $class = shift;
95
    $class->logger->notice("Request for configuration reload");
96 97 98 99 100 101
    return $class->checkConf(1) ? $class->DONE : $class->SERVER_ERROR;
}

*refresh = *reload;

# INTERNAL METHODS
102

103 104 105 106 107
## @imethod void configReload(hashRef conf, hashRef tsv)
# Given a Lemonldap::NG configuration $conf, computes values used to
# handle requests and store them in a thread shared object called $tsv
#
# methods called by configReload, and thread shared values computed, are:
108 109 110
# - jailInit():
#      - jail
# - defaultValuesInit():
111 112 113 114 115 116 117 118
#      (scalars for global options)
#      - cookieExpiration  # warning: absent from default Conf
#      - cookieName
#      - securedCookie,
#      - httpOnly
#      - whatToTrace
#      - customFunctions
#      - timeoutActivity
119
#      - timeoutActivityInterval
120 121 122 123 124 125 126 127 128
#      - useRedirectOnError
#      - useRedirectOnForbidden
#      - useSafeJail
#      (objects)
#      - cipher  # Lemonldap::NG::Common::Crypto object
#      (hashrefs for vhost options)
#      - https
#      - port
#      - maintenance
129
# - portalInit():
130
#      - portal (functions that returns portal URL)
131
# - locationRulesInit():
132 133 134 135 136 137 138
#      - locationCount
#      - defaultCondition
#      - defaultProtection
#      - locationCondition
#      - locationProtection
#      - locationRegexp
#      - locationConditionText
139
# - sessionStorageInit():
140 141 142 143
#      - sessionStorageModule
#      - sessionStorageOptions
#      - sessionCacheModule
#      - sessionCacheOptions
144
# - headersInit():
145 146
#      - headerList
#      - forgeHeaders
147
# - postUrlInit():
148 149
#      - inputPostData
#      - outputPostData
150
# - aliasInit():
151
#      - vhostAlias
152 153 154 155
#
# The *Init() methods can be run in any order,
# but jailInit must be run first because $tsv->{jail}
# is used by locationRulesInit, headersInit and postUrlInit.
156 157 158 159

# @param $conf reference to the configuration hash
# @param $tsv reference to the thread-shared parameters conf
sub configReload {
160
    my ( $class, $conf ) = @_;
161 162
    $class->logger->info(
        "Loading configuration $conf->{cfgNum} for process $$");
163

164
    foreach my $sub (
165
        qw( defaultValuesInit jailInit portalInit locationRulesInit
Clément OUDOT's avatar
Clément OUDOT committed
166 167 168
        sessionStorageInit headersInit postUrlInit aliasInit )
      )
    {
169
        $class->logger->debug("Process $$ calls $sub");
170
        $class->$sub($conf);
171
    }
172 173
    return 1;
}
174

175 176 177 178
## @imethod protected void jailInit(hashRef args)
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub jailInit {
179
    my ( $class, $conf ) = @_;
180

Xavier Guimard's avatar
Xavier Guimard committed
181
    $class->tsv->{jail} = Lemonldap::NG::Handler::Main::Jail->new( {
182 183
            useSafeJail     => $conf->{useSafeJail},
            customFunctions => $conf->{customFunctions},
Xavier Guimard's avatar
Xavier Guimard committed
184 185
        }
    );
186
    $class->tsv->{jail}->build_jail( $class, $conf->{require} );
187
}
188 189 190 191 192

## @imethod protected void defaultValuesInit(hashRef args)
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub defaultValuesInit {
193
    my ( $class, $conf ) = @_;
Clément OUDOT's avatar
Clément OUDOT committed
194

Xavier Guimard's avatar
Xavier Guimard committed
195
    $class->tsv->{$_} = $conf->{$_} foreach ( qw(
Xavier Guimard's avatar
Xavier Guimard committed
196 197 198
        cookieExpiration        cookieName         customFunctions httpOnly
        securedCookie           timeout            timeoutActivity
        timeoutActivityInterval useRedirectOnError useRedirectOnForbidden
Xavier Guimard's avatar
Xavier Guimard committed
199
        useSafeJail             whatToTrace        handlerInternalCache
Christophe Maudoux's avatar
Christophe Maudoux committed
200
        handlerServiceTokenTTL  customToTrace      lwpOpts lwpSslOpts
201
        authChoiceParam         authChoiceAuthBasic
Clément OUDOT's avatar
Clément OUDOT committed
202 203
        )
    );
204

205
    $class->tsv->{cipher} = Lemonldap::NG::Common::Crypto->new( $conf->{key} );
206

207
    foreach my $opt (qw(https port maintenance)) {
208

209 210
        # Record default value in key '_'
        $class->tsv->{$opt} = { _ => $conf->{$opt} };
211 212

        # Override with vhost options
213 214 215
        if ( $conf->{vhostOptions} ) {
            my $name = 'vhost' . ucfirst($opt);
            foreach my $vhost ( keys %{ $conf->{vhostOptions} } ) {
216
                $conf->{vhostOptions}->{$vhost} ||= {};
217
                my $val = $conf->{vhostOptions}->{$vhost}->{$name};
Xavier Guimard's avatar
Xavier Guimard committed
218

219
                # Keep global value if $val is negative
Xavier Guimard's avatar
Xavier Guimard committed
220
                if ( defined $val and $val >= 0 ) {
221 222
                    $class->logger->debug(
                        "Options $opt for vhost $vhost: $val");
Xavier Guimard's avatar
Xavier Guimard committed
223 224
                    $class->tsv->{$opt}->{$vhost} = $val;
                }
225 226 227
            }
        }
    }
228 229 230 231
    if ( $conf->{vhostOptions} ) {
        foreach my $vhost ( keys %{ $conf->{vhostOptions} } ) {
            $class->tsv->{type}->{$vhost} =
              $conf->{vhostOptions}->{$vhost}->{vhostType};
232 233
            $class->tsv->{authnLevel}->{$vhost} =
              $conf->{vhostOptions}->{$vhost}->{vhostAuthnLevel};
234 235
        }
    }
236
    return 1;
237 238 239 240 241 242
}

## @imethod protected void portalInit(hashRef args)
# Verify that portal variable exists. Die unless
# @param $args reference to the configuration hash
sub portalInit {
243
    my ( $class, $conf ) = @_;
244
    unless ( $conf->{portal} ) {
245
        $class->logger->error("portal parameter required");
246 247
        return 0;
    }
248
    if ( $conf->{portal} =~ /[\$\(&\|"']/ ) {
249 250
        ( $class->tsv->{portal} ) =
          $class->conditionSub( $conf->{portal} );
251 252
    }
    else {
253
        $class->tsv->{portal} = sub { return $conf->{portal} };
254
    }
255
    return 1;
256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
}

## @imethod void locationRulesInit(hashRef args)
# Compile rules.
# Rules are stored in $args->{locationRules}->{<virtualhost>} that contains
# regexp=>test expressions where :
# - regexp is used to test URIs
# - test contains an expression used to grant the user
#
# This function creates 2 hashRef containing :
# - one list of the compiled regular expressions for each virtual host
# - one list of the compiled functions (compiled with conditionSub()) for each
# virtual host
# @param $args reference to the configuration hash
sub locationRulesInit {
Xavier Guimard's avatar
Xavier Guimard committed
271 272 273
    my ( $class, $conf, $orules ) = @_;

    $orules ||= $conf->{locationRules};
274

Xavier Guimard's avatar
Xavier Guimard committed
275 276 277
    foreach my $vhost ( keys %$orules ) {
        my $rules = $orules->{$vhost};
        $class->tsv->{locationCount}->{$vhost} = 0;
Clément OUDOT's avatar
Clément OUDOT committed
278
        foreach my $url ( sort keys %{$rules} ) {
279
            my ( $cond, $prot ) = $class->conditionSub( $rules->{$url} );
Xavier Guimard's avatar
Xavier Guimard committed
280
            unless ($cond) {
281
                $class->tsv->{maintenance}->{$vhost} = 1;
282
                $class->logger->error(
Xavier Guimard's avatar
Xavier Guimard committed
283
                    "Unable to build rule '$rules->{$url}': "
284
                      . $class->tsv->{jail}->error );
Xavier Guimard's avatar
Xavier Guimard committed
285 286
                next;
            }
287

288
            if ( $url eq 'default' ) {
289 290
                $class->tsv->{defaultCondition}->{$vhost}  = $cond;
                $class->tsv->{defaultProtection}->{$vhost} = $prot;
291 292
            }
            else {
293 294 295 296
                push @{ $class->tsv->{locationCondition}->{$vhost} },  $cond;
                push @{ $class->tsv->{locationProtection}->{$vhost} }, $prot;
                push @{ $class->tsv->{locationRegexp}->{$vhost} },     qr/$url/;
                push @{ $class->tsv->{locationConditionText}->{$vhost} },
Xavier Guimard's avatar
Xavier Guimard committed
297 298 299
                    $cond =~ /^\(\?#(.*?)\)/ ? $1
                  : $cond =~ /^(.*?)##(.+)$/ ? $2
                  :                            $url;
300
                $class->tsv->{locationCount}->{$vhost}++;
301
            }
302 303
        }

304
        # Default policy set to 'accept'
305
        unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
306
            $class->tsv->{defaultCondition}->{$vhost}  = sub { 1 };
307
            $class->tsv->{defaultProtection}->{$vhost} = 0;
308
        }
309
    }
310
    return 1;
311 312
}

313 314 315
## @imethod protected void sessionStorageInit(hashRef args)
# Initialize the Apache::Session::* module choosed to share user's variables
# and the Cache::Cache module choosed to cache sessions
316
# @param $args reference to the configuration hash
317
sub sessionStorageInit {
318
    my ( $class, $conf ) = @_;
319 320

    # Global session storage
321
    unless ( $class->tsv->{sessionStorageModule} = $conf->{globalStorage} ) {
322
        $class->logger->error("globalStorage required");
323 324
        return 0;
    }
325
    eval "use " . $class->tsv->{sessionStorageModule};
326
    die($@) if ($@);
327
    $class->tsv->{sessionStorageOptions} = $conf->{globalStorageOptions};
328

329 330
    # OIDC session storage
    if ( $conf->{oidcStorage} ) {
331
        eval "use " . $conf->{oidcStorage};
332 333 334 335 336 337 338 339 340 341 342
        die($@) if ($@);
        $class->tsv->{oidcStorageModule}  = $conf->{oidcStorage};
        $class->tsv->{oidcStorageOptions} = $conf->{oidcStorageOptions};

    }
    else {
        $class->tsv->{oidcStorageModule}  = $conf->{globalStorage};
        $class->tsv->{oidcStorageOptions} = $conf->{globalStorageOptions};
    }

    # Local session storage
Clément OUDOT's avatar
Clément OUDOT committed
343
    if ( $conf->{localSessionStorage} ) {
344 345 346 347
        $class->tsv->{sessionCacheModule} = $conf->{localSessionStorage};
        $class->tsv->{sessionCacheOptions} =
          $conf->{localSessionStorageOptions};
        $class->tsv->{sessionCacheOptions}->{default_expires_in} ||= 600;
Clément OUDOT's avatar
Clément OUDOT committed
348 349

        if ( $conf->{status} ) {
350
            my $params = "";
351
            if ( $class->tsv->{sessionCacheModule} ) {
352 353 354 355 356 357 358
                $params = ' ' . join(
                    ',',
                    $class->tsv->{sessionCacheModule} . map {
                        "$_ => "
                          . $class->tsv->{sessionCacheOptions}->{$_}
                    } keys %{ $class->tsv->{sessionCacheOptions} // {} }
                );
359
            }
360
            $class->tsv->{statusPipe}->print("RELOADCACHE $params\n");
361 362
        }
    }
363
return 1;
364 365
}

366 367
## @imethod void headersInit(hashRef args)
# Create the subroutines used to insert headers into the HTTP request.
368
# @param $args reference to the configuration hash
369
sub headersInit {
Xavier Guimard's avatar
Xavier Guimard committed
370 371
    my ( $class, $conf, $headers ) = @_;
    $headers ||= $conf->{exportedHeaders};
372 373

    # Creation of the subroutine which will generate headers
Xavier Guimard's avatar
Xavier Guimard committed
374
    foreach my $vhost ( keys %{$headers} ) {
Xavier Guimard's avatar
Xavier Guimard committed
375 376 377 378
        unless ($vhost) {
            $class->logger->warn('Empty vhost in headers, skipping');
            next;
        }
379
        $headers->{$vhost} ||= {};
Xavier Guimard's avatar
Xavier Guimard committed
380
        my %headers = %{ $headers->{$vhost} };
381
        $class->tsv->{headerList}->{$vhost} = [ keys %headers ];
Xavier Guimard's avatar
Xavier Guimard committed
382
        my $sub = '';
383
        foreach ( keys %headers ) {
384 385
            $headers{$_} ||= "''";
            my $val = $class->substitute( $headers{$_} ) . " // ''";
386
            $sub .= "('$_' => $val),";
387 388
        }

389
        unless ( $class->tsv->{forgeHeaders}->{$vhost} =
Xavier Guimard's avatar
Xavier Guimard committed
390
            $class->buildSub($sub) )
391
        {
392
            $class->tsv->{maintenance}->{$vhost} = 1;
393
            $class->logger->error( "$class Unable to forge $vhost headers: "
394
                  . $class->tsv->{jail}->error );
395
        }
396
    }
397
    return 1;
398 399 400 401 402
}

## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub postUrlInit {
403
    my ( $class, $conf ) = @_;
404
    return unless ( $conf->{post} );
405 406

    # Browse all vhost
407
    foreach my $vhost ( keys %{ $conf->{post} } ) {
Clément OUDOT's avatar
Clément OUDOT committed
408

409
        #  Browse all POST URI
410
        foreach my $url ( keys %{ $conf->{post}->{$vhost} || {} } ) {
411
            my $d = $conf->{post}->{$vhost}->{$url};
412
            $class->logger->debug("Compiling POST data for $url");
413 414

            # Where to POST
415
            $d->{target} ||= $url;
416
            my $sub;
417 418
            $d->{vars} ||= [];
            foreach my $input ( @{ delete $d->{vars} } ) {
419 420
                $sub .=
                  "'$input->[0]' => " . $class->substitute( $input->[1] ) . ",";
421
            }
422 423 424
            unless (
                $class->tsv->{inputPostData}->{$vhost}->{ delete $d->{target} }
                = $class->tsv->{outputPostData}->{$vhost}->{$url} =
Xavier Guimard's avatar
Xavier Guimard committed
425
                $class->buildSub($sub) )
426
            {
427
                $class->tsv->{maintenance}->{$vhost} = 1;
Xavier Guimard's avatar
Xavier Guimard committed
428
                $class->logger->error( "$class: Unable to build post data: "
429
                      . $class->tsv->{jail}->error );
430
            }
431

432
            $class->tsv->{postFormParams}->{$vhost}->{$url} = $d;
433 434
        }
    }
435
    return 1;
436 437 438 439 440 441 442
}

## @imethod protected codeRef conditionSub(string cond)
# Returns a compiled function used to grant users (used by
# locationRulesInit(). The second value returned is a non null
# constant if URL is not protected (by "unprotect" or "skip"), 0 else.
# @param $cond The boolean expression to use
443
# @param $mainClass  optional
444 445
# @return array (ref(sub), int)
sub conditionSub {
446
    my ( $class, $cond ) = @_;
447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
    my ( $OK, $NOK ) = ( sub { 1 }, sub { 0 } );

    # Simple cases : accept and deny
    return ( $OK, 0 )
      if ( $cond =~ /^accept$/i );
    return ( $NOK, 0 )
      if ( $cond =~ /^deny$/i );

    # Cases unprotect and skip : 2nd value is 1 or 2
    return ( $OK, UNPROTECT )
      if ( $cond =~ /^unprotect$/i );
    return ( $OK, SKIP )
      if ( $cond =~ /^skip$/i );

    # Case logout
    if ( $cond =~ /^logout(?:_sso)?(?:\s+(.*))?$/i ) {
        my $url = $1;
        return (
            $url
            ? (
                sub {
468
                    $_[1]->{_logout} = $url;
469 470 471 472 473 474
                    return 0;
                },
                0
              )
            : (
                sub {
475
                    $_[1]->{_logout} = $class->tsv->{portal}->();
476 477 478 479 480 481 482 483 484 485
                    return 0;
                },
                0
            )
        );
    }

    # Since filter exists only with Apache>=2, logout_app and logout_app_sso
    # targets are available only for it.
    # This error can also appear with Manager configured as CGI script
486
    if ( $cond =~ /^logout_app/i
Xavier Guimard's avatar
Xavier Guimard committed
487
        and not $class->isa('Lemonldap::NG::Handler::ApacheMP2::Main') )
488
    {
489 490
        $class->logger->info(
            "Rules logout_app and logout_app_sso require Apache>=2");
491 492 493 494 495
        return ( sub { 1 }, 0 );
    }

    # logout_app
    if ( $cond =~ /^logout_app(?:\s+(.*))?$/i ) {
Xavier Guimard's avatar
Xavier Guimard committed
496
        my $u = $1 || $class->tsv->{portal}->();
497 498 499
        eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
        return (
            sub {
Xavier Guimard's avatar
Xavier Guimard committed
500
                $_[0]->{env}->{'psgi.r'}->add_output_filter(
501
                    sub {
Xavier Guimard's avatar
#994  
Xavier Guimard committed
502
                        return $class->redirectFilter( $u, @_ );
503
                    }
504
                );
505 506 507 508 509 510
                1;
            },
            0
        );
    }
    elsif ( $cond =~ /^logout_app_sso(?:\s+(.*))?$/i ) {
Xavier Guimard's avatar
Xavier Guimard committed
511
        my $u = $1 || $class->tsv->{portal}->();
Xavier Guimard's avatar
Xavier Guimard committed
512
        eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
513 514
        return (
            sub {
Xavier Guimard's avatar
#994  
Xavier Guimard committed
515

516
                my ($req) = @_;
Xavier Guimard's avatar
#994  
Xavier Guimard committed
517
                $class->localUnlog;
518
                $req->{env}->{'psgi.r'}->add_output_filter(
519
                    sub {
Xavier Guimard's avatar
#994  
Xavier Guimard committed
520 521
                        my $r = $_[0]->r;
                        return $class->redirectFilter(
522
                            &{ $class->tsv->{portal} }() . "?url="
523
                              . $class->encodeUrl( $req, $u )
524 525 526 527
                              . "&logout=1",
                            @_
                        );
                    }
528
                );
529 530 531 532 533 534 535
                1;
            },
            0
        );
    }

    # Replace some strings in condition
536
    $cond = $class->substitute($cond);
537
    my $sub;
Xavier Guimard's avatar
Xavier Guimard committed
538
    unless ( $sub = $class->buildSub($cond) ) {
539 540
        $class->logger->error( "$class: Unable to build condition ($cond): "
              . $class->tsv->{jail}->error );
541
    }
542 543 544 545 546

    # Return sub and protected flag
    return ( $sub, 0 );
}

547
## @method arrayref aliasInit
548 549
# @param options vhostOptions configuration item
# @return arrayref of vhost and aliases
550
sub aliasInit {
551
    my ( $class, $conf ) = @_;
552

553
    foreach my $vhost ( keys %{ $conf->{vhostOptions} || {} } ) {
Xavier Guimard's avatar
Xavier Guimard committed
554
        if ( my $aliases = $conf->{vhostOptions}->{$vhost}->{vhostAliases} ) {
555
            foreach ( split /\s+/, $aliases ) {
556
                $class->tsv->{vhostAlias}->{$_} = $vhost;
557
                $class->logger->debug("Registering $_ as alias of $vhost");
558
            }
559 560
        }
    }
561
    return 1;
562
}
Clément OUDOT's avatar
Clément OUDOT committed
563

564
# TODO: support wildcards in aliases
565

566
sub substitute {
567
    my ( $class, $expr ) = @_;
568

569
    # substitute special vars, just for retro-compatibility
570
    $expr =~ s/\$date\b/&date/sg;
571 572
    $expr =~ s/\$vhost\b/\$ENV{HTTP_HOST}/sg;
    $expr =~ s/\$ip\b/\$ENV{REMOTE_ADDR}/sg;
573

Xavier Guimard's avatar
Xavier Guimard committed
574
    # substitute vars with session data, excepts special vars $_ and $\d+
Xavier Guimard's avatar
Xavier Guimard committed
575
    $expr =~ s/\$(?!(?:ENV|env)\b)(_\w+|[a-zA-Z]\w*)/\$s->{$1}/sg;
576
    $expr =~ s/\$ENV\{/\$r->{env}->\{/g;
577
    $expr =~ s/\$env->\{/\$r->{env}->\{/g;
578 579

    return $expr;
580 581
}

Xavier Guimard's avatar
Xavier Guimard committed
582 583
sub buildSub {
    my ( $class, $val ) = @_;
584
    my $res =
585
      $class->tsv->{jail}->jail_reval("sub{my (\$r,\$s)=\@_;return($val)}");
586 587 588 589
    unless ($res) {
        $class->logger->error( $class->tsv->{jail}->error );
    }
    return $res;
Xavier Guimard's avatar
Xavier Guimard committed
590 591
}

592
1;