Safe.pm 3.32 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
## @file
# LL::NG module for Safe jail

## @package
# LL::NG module for Safe jail
package Lemonldap::NG::Common::Safe;

use strict;
use base qw(Safe);
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );

12
our $VERSION = 1.1.0;
13

14
our $self;    # Safe cannot share a variable declared with my
15
16
17
18
19
20
21
22
23
24
25

## @constructor Lemonldap::NG::Common::Safe new(Lemonldap::NG::Portal::Simple portal)
# Build a new Safe object
# @param portal Lemonldap::NG::Portal::Simple object
# @return Lemonldap::NG::Common::Safe object
sub new {
    my ( $class, $portal ) = splice @_;
    my $self = {};

    unless ( $portal->{useSafeJail} ) {

26
        # Fake jail
27
28
29
30
31
        $portal->lmLog( "Creating a fake Safe jail", 'debug' );
        bless $self, $class;
    }
    else {

32
        # Safe jail
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
        $self = $class->SUPER::new();
        $portal->lmLog( "Creating a real Safe jail", 'debug' );
    }

    # Store portal object
    $self->{p} = $portal;

    return $self;
}

## @method reval(string $e)
# Evaluate an expression, inside or outside jail
# @param e Expression to evaluate
sub reval {
    local $self = shift;
    my ($e) = splice @_;
    my $result;

    # Replace $date
    $e =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;

    # Replace variables by session content
55
56
57
58
59
60
61
    # Manage subroutine not the same way as plain perl expressions
    if ( $e =~ /^sub\s*{/ ) {
        $e =~ s/\$(?!ENV)(?!self)(\w+)/\$self->{sessionInfo}->{$1}/g;
    }
    else {
        $e =~ s/\$(?!ENV)(\w+)/\$self->{p}->{sessionInfo}->{$1}/g;
    }
62
63
64
65
66
67
68
69
70
71

    $self->{p}->lmLog( "Evaluate expression: $e", 'debug' );

    if ( $self->{p}->{useSafeJail} ) {

        # Share $self to access sessionInfo HASH
        $self->SUPER::share('$self');

        # Test SAFEWRAP and run reval
        $result = (
72
            ( SAFEWRAP and ref($e) eq 'CODE' )
73
74
75
76
77
78
            ? $self->SUPER::wrap_code_ref( $self->SUPER::reval($e) )
            : $self->SUPER::reval($e)
        );
    }
    else {

79
        # Use a standard eval
80
81
82
        $result = eval $e;
    }

83
84
    # Catch errors
    if ($@) {
Yadd's avatar
Yadd committed
85
86
        $self->{p}
          ->lmLog( "Error while evaluating the expression: $@", 'warn' );
87
88
89
90
        return;
    }

    $self->{p}->lmLog( "Evaluation result: $result", 'debug' );
91
92
93
94

    return $result;
}

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
## @method share_from(string $pkg, arrayref $vars)
# Share variables into Safe jail
# @param pkg Package
# @param vars Varibales
sub share_from {
    local $self = shift;
    my ( $pkg, $vars ) = splice(@_);

    # If Safe jail, call parent
    if ( $self->{p}->{useSafeJail} ) {
        $self->SUPER::share_from( $pkg, $vars );
    }

    # Else register varibales into current package
    # Code copied from Safe.pm
    else {
        no strict 'refs';
        foreach my $arg (@$vars) {
            my ( $var, $type );
            $type = $1 if ( $var = $arg ) =~ s/^(\W)//;
            for ( 1 .. 2 ) {    # assign twice to avoid any 'used once' warnings
                *{$var} =
                    ( !$type ) ? \&{ $pkg . "::$var" }
                  : ( $type eq '&' ) ? \&{ $pkg . "::$var" }
                  : ( $type eq '$' ) ? \${ $pkg . "::$var" }
                  : ( $type eq '@' ) ? \@{ $pkg . "::$var" }
                  : ( $type eq '%' ) ? \%{ $pkg . "::$var" }
                  : ( $type eq '*' ) ? *{ $pkg . "::$var" }
                  :                    undef;
            }
        }

    }
}

130
1;