181 lines
4.3 KiB
Perl
181 lines
4.3 KiB
Perl
package Lemonldap::NG::Handler::Main::Jail;
|
||
|
||
use strict;
|
||
|
||
use Safe;
|
||
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
||
|
||
# Workaround for another ModPerl/Mouse issue...
|
||
BEGIN {
|
||
require Mouse;
|
||
no warnings;
|
||
my $v = $Mouse::VERSION
|
||
? sprintf( "%d.%03d%03d", ( $Mouse::VERSION =~ /(\d+)/g ) )
|
||
: 0;
|
||
if ( $v < 2.005001 and $Lemonldap::NG::Handler::Apache2::Main::VERSION ) {
|
||
require Moose;
|
||
Moose->import();
|
||
}
|
||
else {
|
||
Mouse->import();
|
||
}
|
||
}
|
||
|
||
has customFunctions => ( is => 'rw', isa => 'Maybe[Str]' );
|
||
|
||
has useSafeJail => ( is => 'rw', isa => 'Maybe[Int]' );
|
||
|
||
has jail => ( is => 'rw' );
|
||
|
||
has error => ( is => 'rw' );
|
||
|
||
our $VERSION = '2.0.0';
|
||
|
||
## @imethod protected build_jail()
|
||
# Build and return the security jail used to compile rules and headers.
|
||
# @return Safe object
|
||
sub build_jail {
|
||
my ( $self, $api, $require ) = @_;
|
||
|
||
return $self->jail
|
||
if ( $self->jail
|
||
and $self->jail->useSafeJail
|
||
and $self->useSafeJail
|
||
and $self->jail->useSafeJail == $self->useSafeJail );
|
||
|
||
$self->useSafeJail(1) unless defined $self->useSafeJail;
|
||
|
||
if ($require) {
|
||
foreach my $f ( split /[, ]+/, $require ) {
|
||
if ( $f =~ /^[\w\:]+$/ ) {
|
||
eval "require $f";
|
||
}
|
||
else {
|
||
eval { require $f; };
|
||
}
|
||
if ($@) {
|
||
die "Unable to load '$f': $@";
|
||
}
|
||
}
|
||
}
|
||
|
||
my @t =
|
||
$self->customFunctions ? split( /\s+/, $self->customFunctions ) : ();
|
||
foreach (@t) {
|
||
no warnings 'redefine';
|
||
$api->logger->debug("Custom function : $_");
|
||
my $sub = $_;
|
||
unless (/::/) {
|
||
$sub = "$self\::$_";
|
||
}
|
||
else {
|
||
s/^.*:://;
|
||
}
|
||
next if ( $self->can($_) );
|
||
eval "sub $_ {
|
||
return $sub(\@_)
|
||
}";
|
||
$api->logger->error($@) if ($@);
|
||
$_ = "&$_";
|
||
}
|
||
|
||
if ( $self->useSafeJail ) {
|
||
$self->jail( Safe->new );
|
||
}
|
||
else {
|
||
$self->jail($self);
|
||
}
|
||
|
||
# Share objects with Safe jail
|
||
$self->jail->share_from( 'Lemonldap::NG::Common::Safelib',
|
||
$Lemonldap::NG::Common::Safelib::functions );
|
||
|
||
$self->jail->share_from( __PACKAGE__, [ @t, '&encrypt', '&token' ] );
|
||
$self->jail->share_from( 'MIME::Base64', ['&encode_base64'] );
|
||
|
||
#$self->jail->share_from( 'Lemonldap::NG::Handler::Main', ['$_v'] );
|
||
|
||
# Initialize cryptographic functions to be able to use them in jail.
|
||
eval { token('a') };
|
||
|
||
return $self->jail;
|
||
}
|
||
|
||
# Import crypto methods for jail
|
||
sub encrypt {
|
||
return &Lemonldap::NG::Handler::Main::tsv->{cipher}->encrypt(@_);
|
||
}
|
||
|
||
sub token {
|
||
return encrypt( join( ':', time, @_ ) );
|
||
}
|
||
|
||
## @method reval
|
||
# Fake reval method if useSafeJail is off
|
||
sub reval {
|
||
my ( $self, $e ) = @_;
|
||
|
||
my $res = eval $e;
|
||
if ($@) {
|
||
$self->error($@);
|
||
return undef;
|
||
}
|
||
return $res;
|
||
}
|
||
|
||
## @method wrap_code_ref
|
||
# Fake wrap_code_ref method if useSafeJail is off
|
||
sub wrap_code_ref {
|
||
my ( $self, $e ) = @_;
|
||
return $e;
|
||
}
|
||
|
||
## @method share
|
||
# Fake share method if useSafeJail is off
|
||
sub share {
|
||
my ( $self, @vars ) = @_;
|
||
$self->share_from( scalar(caller), \@vars );
|
||
}
|
||
|
||
## @method share_from
|
||
# Fake share_from method if useSafeJail is off
|
||
sub share_from {
|
||
my ( $self, $pkg, $vars ) = @_;
|
||
|
||
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;
|
||
}
|
||
}
|
||
}
|
||
|
||
## @imethod protected jail_reval()
|
||
# Build and return restricted eval command
|
||
# @return evaluation of $reval or $reval2
|
||
sub jail_reval {
|
||
my ( $self, $reval ) = @_;
|
||
|
||
# if nothing is returned by reval, add the return statement to
|
||
# the "no safe wrap" reval
|
||
|
||
my $res;
|
||
eval { $res = ( $self->jail->reval($reval) ) };
|
||
if ($@) {
|
||
$self->error($@);
|
||
return undef;
|
||
}
|
||
return $res;
|
||
}
|
||
|
||
1;
|