BEGIN {
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
) {
Moose->
import
();
}
else
{
Mouse->
import
();
}
}
has
customFunctions
=> (
is
=>
'rw'
,
isa
=>
'Maybe[Str]'
);
has
useSafeJail
=> (
is
=>
'rw'
,
isa
=>
'Maybe[Int]'
);
has
multiValuesSeparator
=> (
is
=>
'rw'
,
isa
=>
'Maybe[Str]'
);
has
jail
=> (
is
=>
'rw'
);
has
error
=> (
is
=>
'rw'
);
our
$VERSION
=
'2.18.0'
;
our
@builtCustomFunctions
;
sub
build_jail {
my
(
$self
,
$api
,
$require
,
$dontDie
) =
@_
;
my
$build
= 1;
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
/[,\s]+/,
$require
) {
if
(
$f
=~ /^[\w\:]+$/ ) {
eval
"require $f"
;
}
else
{
eval
{
require
$f
; };
}
if
($@) {
$dontDie
?
$api
->logger->error($@)
:
die
"Unable to load '$f': $@"
;
undef
$build
;
}
}
}
if
(
$build
) {
@builtCustomFunctions
=
$self
->customFunctions
?
split
( /[,\s]+/,
$self
->customFunctions )
: ();
foreach
(
@builtCustomFunctions
) {
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
);
}
$self
->jail->share_from(
'Lemonldap::NG::Common::Safelib'
,
$Lemonldap::NG::Common::Safelib::functions
);
{
no
warnings
'redefine'
;
*listMatch
=
sub
{
return
Lemonldap::NG::Common::Safelib::listMatch(
$self
->multiValuesSeparator,
@_
);
};
}
$self
->jail->share_from( __PACKAGE__,
[
@builtCustomFunctions
,
'&encrypt'
,
'&decrypt'
,
'&token'
,
'&listMatch'
] );
$self
->jail->share_from(
'MIME::Base64'
, [
'&encode_base64'
] );
eval
{ token(
'a'
) };
return
$self
->jail;
}
sub
encrypt {
return
&Lemonldap::NG::Handler::Main::tsv
->{cipher}->encrypt(
$_
[0], 1 );
}
sub
decrypt {
return
&Lemonldap::NG::Handler::Main::tsv
->{cipher}->decrypt(
$_
[0] );
}
sub
token {
return
$_
[0] ? encrypt(
join
(
':'
,
time
,
@_
) ) : encrypt(
time
);
}
sub
reval {
my
(
$self
,
$e
) =
@_
;
return
eval
$e
;
}
sub
wrap_code_ref {
my
(
$self
,
$e
) =
@_
;
return
$e
;
}
sub
share {
my
(
$self
,
@vars
) =
@_
;
$self
->share_from(
scalar
(
caller
), \
@vars
);
}
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 ) {
*{
$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
;
}
}
}
sub
jail_reval {
my
(
$self
,
$reval
) =
@_
;
my
$res
=
$self
->jail->reval(
$reval
);
if
($@) {
$self
->error($@);
return
undef
;
}
return
$res
;
}
1;