Jail.pm 3.95 KB
Newer Older
1 2 3 4 5 6
package Lemonldap::NG::Handler::Main::Jail;

use strict;

use Safe;
use Lemonldap::NG::Common::Safelib;    #link protected safe Safe object
7

Yadd's avatar
Temp  
Yadd committed
8 9 10 11 12
use Moo;

has customFunctions => ( is => 'rw' );

has useSafeJail => ( is => 'rw' );
13

14
has jail => ( is => 'rw' );
15

Yadd's avatar
Yadd committed
16 17
has error => ( is => 'rw' );

Yadd's avatar
Yadd committed
18
our $VERSION = '2.0.0';
19

20
## @imethod protected build_jail()
21 22
# Build and return the security jail used to compile rules and headers.
# @return Safe object
23
sub build_jail {
Yadd's avatar
Yadd committed
24
    my ( $self, $api, $require ) = @_;
25

26
    return $self->jail
Yadd's avatar
Yadd committed
27 28 29
      if (  $self->jail
        and $self->jail->useSafeJail
        and $self->useSafeJail
Yadd's avatar
Yadd committed
30
        and $self->jail->useSafeJail == $self->useSafeJail );
31 32 33

    $self->useSafeJail(1) unless defined $self->useSafeJail;

Yadd's avatar
Yadd committed
34 35 36
    if ($require) {
        foreach my $f ( split /[, ]+/, $require ) {
            if ( $f =~ /^[\w\:]+$/ ) {
Yadd's avatar
Yadd committed
37 38 39
                eval "require $f";
            }
            else {
Yadd's avatar
Yadd committed
40
                eval { require $f; };
Yadd's avatar
Yadd committed
41
            }
Yadd's avatar
Yadd committed
42 43
            if ($@) {
                die "Unable to load '$f': $@";
Yadd's avatar
Yadd committed
44 45 46 47
            }
        }
    }

48 49 50
    my @t =
      $self->customFunctions ? split( /\s+/, $self->customFunctions ) : ();
    foreach (@t) {
Yadd's avatar
Yadd committed
51
        no warnings 'redefine';
Yadd's avatar
Yadd committed
52
        $api->logger->debug("Custom function : $_");
53 54 55 56 57 58 59 60 61
        my $sub = $_;
        unless (/::/) {
            $sub = "$self\::$_";
        }
        else {
            s/^.*:://;
        }
        next if ( $self->can($_) );
        eval "sub $_ {
Yadd's avatar
Yadd committed
62
            return $sub(\@_)
63
        }";
Yadd's avatar
Yadd committed
64
        $api->logger->error($@) if ($@);
65
        $_ = "&$_";
66 67 68
    }

    if ( $self->useSafeJail ) {
69
        $self->jail( Safe->new );
70 71
    }
    else {
72
        $self->jail($self);
73 74 75
    }

    # Share objects with Safe jail
76
    $self->jail->share_from( 'Lemonldap::NG::Common::Safelib',
77 78
        $Lemonldap::NG::Common::Safelib::functions );

Yadd's avatar
Yadd committed
79
    $self->jail->share_from( __PACKAGE__, [ @t, '&encrypt', '&token' ] );
80
    $self->jail->share_from( 'MIME::Base64', ['&encode_base64'] );
81 82

    #$self->jail->share_from( 'Lemonldap::NG::Handler::Main', ['$_v'] );
83

84 85 86
    # Initialize cryptographic functions to be able to use them in jail.
    eval { token('a') };

87
    return $self->jail;
88 89
}

90 91
# Import crypto methods for jail
sub encrypt {
Yadd's avatar
Yadd committed
92 93 94 95 96
    return &Lemonldap::NG::Handler::Main::tsv->{cipher}->encrypt(@_);
}

sub token {
    return encrypt( join( ':', time, @_ ) );
97 98
}

99 100 101
## @method reval
# Fake reval method if useSafeJail is off
sub reval {
Yadd's avatar
Yadd committed
102
    my ( $self, $e ) = @_;
Yadd's avatar
Yadd committed
103

104 105 106 107 108 109
    my $res = eval $e;
    if ($@) {
        $self->error($@);
        return undef;
    }
    return $res;
110 111 112 113 114
}

## @method wrap_code_ref
# Fake wrap_code_ref method if useSafeJail is off
sub wrap_code_ref {
Yadd's avatar
Yadd committed
115
    my ( $self, $e ) = @_;
116 117 118 119 120 121
    return $e;
}

## @method share
# Fake share method if useSafeJail is off
sub share {
Yadd's avatar
Yadd committed
122
    my ( $self, @vars ) = @_;
123 124 125 126 127 128
    $self->share_from( scalar(caller), \@vars );
}

## @method share_from
# Fake share_from method if useSafeJail is off
sub share_from {
Yadd's avatar
Yadd committed
129
    my ( $self, $pkg, $vars ) = @_;
130 131 132 133 134 135 136

    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} =
Clément OUDOT's avatar
Clément OUDOT committed
137
                ( !$type )       ? \&{ $pkg . "::$var" }
138 139 140 141 142 143 144 145 146 147 148
              : ( $type eq '&' ) ? \&{ $pkg . "::$var" }
              : ( $type eq '$' ) ? \${ $pkg . "::$var" }
              : ( $type eq '@' ) ? \@{ $pkg . "::$var" }
              : ( $type eq '%' ) ? \%{ $pkg . "::$var" }
              : ( $type eq '*' ) ? *{ $pkg . "::$var" }
              :                    undef;
        }
    }
}

## @imethod protected jail_reval()
149
# Build and return restricted eval command
150 151
# @return evaluation of $reval or $reval2
sub jail_reval {
Yadd's avatar
Yadd committed
152
    my ( $self, $reval ) = @_;
153

Clément OUDOT's avatar
Clément OUDOT committed
154
    # if nothing is returned by reval, add the return statement to
dcoutadeur dcoutadeur's avatar
 
dcoutadeur dcoutadeur committed
155 156
    # the "no safe wrap" reval

157
    my $res;
158
    eval { $res = ( $self->jail->reval($reval) ) };
159 160 161 162 163
    if ($@) {
        $self->error($@);
        return undef;
    }
    return $res;
164 165 166
}

1;