dani
/
lemonldap-ng
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Optimize perlExpr handling (#1717)

This commit is contained in:
Xavier 2019-06-10 08:56:56 +02:00
parent 69e7ea7938
commit a1ea32981c
4 changed files with 49 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fastcgi-server/man/llng-fastcgi-server.1p
View File

@ -133,7 +133,7 @@
.\" ========================================================================
.\"
.IX Title "llng-fastcgi-server 1"
.TH llng-fastcgi-server 1 "2019-04-23" "perl v5.28.1" "User Contributed Perl Documentation"
.TH llng-fastcgi-server 1 "2019-06-06" "perl v5.28.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l

206
lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm
View File

@ -3,6 +3,22 @@ package Lemonldap::NG::Manager::Attributes;
our $VERSION = '2.0.5';
sub perlExpr {
my ( $val, $conf ) = @_;
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; } split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
}
sub types {
return {
'array' => {
@ -27,21 +43,7 @@ sub types {
'boolOrExpr' => {
'msgFail' => '__notAValidPerlExpression__',
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
}
},
'catAndAppList' => {
@ -669,21 +671,7 @@ sub attributes {
},
'casAppMetaDataOptionsRule' => {
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'text'
},
@ -804,21 +792,7 @@ qr/(?:(?:https?):\/\/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.]
'checkUserIdRule' => {
'default' => 1,
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'text'
},
@ -1124,21 +1098,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'keyMsgFail' => '__badHeaderName__',
'keyTest' => qr/^(?=[^\-])[\w\-]+(?<=[^-])$/,
'test' => sub {
my ( $val, $conf ) = @_;
my $s = $val;
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
}
},
'type' => 'keyTextContainer'
@ -1226,21 +1186,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
},
'grantSessionRules' => {
'keyTest' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'test' => sub {
1;
@ -1250,21 +1196,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'groups' => {
'default' => {},
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'keyTextContainer'
},
@ -1299,21 +1231,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'impersonationIdRule' => {
'default' => 1,
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'text'
},
@ -1659,19 +1577,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
: ( 0, '__badUrl__' );
}
$s =~ s/\b(accept|deny|unprotect|skip)\b/1/g;
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return &perlExpr( $s, $conf );
}
},
'type' => 'ruleContainer'
@ -1704,21 +1610,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'keyMsgFail' => '__badMacroName__',
'keyTest' => qr/^[_a-zA-Z][a-zA-Z0-9_]*$/,
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'keyTextContainer'
},
@ -2100,21 +1992,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
},
'oidcRPMetaDataOptionsRule' => {
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'text'
},
@ -2451,21 +2329,7 @@ qr/(?:(?:https?):\/\/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.]
'portalSkinRules' => {
'keyMsgFail' => '__badSkinRule__',
'keyTest' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'msgFail' => '__badValue__',
'test' => qr/^\w+$/,
@ -3200,21 +3064,7 @@ qr/(?:(?:https?):\/\/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.]
},
'samlSPMetaDataOptionsRule' => {
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = 'Safe'->new;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
split( /\n/, $@, 0 ) )
);
return $err ? ( 1, "__badExpression__: $err" ) : 1;
return perlExpr(@_);
},
'type' => 'text'
},

5
lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build.pm
View File

@ -370,6 +370,9 @@ EOF
} keys(%$attributes)
};
$managerAttr = mydump( $managerAttr, 'attributes' );
my $managerSub = Dumper( \&Lemonldap::NG::Manager::Build::Attributes::perlExpr );
$managerSub =~ s/\$VAR1 = sub/sub perlExpr/s;
$managerSub =~ s/^\s*(?:use strict;|package .*?;|)\n//gm;
my $managerTypes =
mydump( Lemonldap::NG::Manager::Build::Attributes::types(), 'types' );
$managerAttr = "# This file is generated by $module. Don't modify it by hand
@ -377,6 +380,8 @@ package Lemonldap::NG::Manager::Attributes;
our \$VERSION = '$Lemonldap::NG::Manager::Build::Attributes::VERSION';
$managerSub
$managerTypes}
$managerAttr}

54
lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm
View File

@ -10,16 +10,15 @@ our $VERSION = '2.0.5';
use strict;
use Regexp::Common qw/URI/;
my $perlExpr = sub {
sub perlExpr {
my ( $val, $conf ) = @_;
my $s = '';
my $cpt = new Safe;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s $val");
$cpt->reval("BEGIN { warnings->unimport; } $val");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ } split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
@ -96,7 +95,7 @@ sub types {
msgFail => '__authorizedValues__: -1, 0, 1',
},
boolOrExpr => {
test => $perlExpr,
test => sub { return perlExpr(@_) },
msgFail => '__notAValidPerlExpression__',
},
keyTextContainer => {
@ -430,7 +429,7 @@ sub attributes {
},
checkUserIdRule => {
type => 'text',
test => $perlExpr,
test => sub { return perlExpr(@_) },
default => 1,
documentation => 'checkUser identities rule',
},
@ -471,7 +470,7 @@ sub attributes {
},
impersonationIdRule => {
type => 'text',
test => $perlExpr,
test => sub { return perlExpr(@_) },
default => 1,
documentation => 'Impersonation identities rule',
},
@ -626,7 +625,7 @@ sub attributes {
portalSkinRules => {
type => 'keyTextContainer',
help => 'portalcustom.html',
keyTest => $perlExpr,
keyTest => sub { return perlExpr(@_) },
keyMsgFail => '__badSkinRule__',
test => qr/^\w+$/,
msgFail => '__badValue__',
@ -699,7 +698,7 @@ sub attributes {
},
grantSessionRules => {
type => 'grantContainer',
keyTest => $perlExpr,
keyTest => sub { return perlExpr(@_) },
test => sub { 1 },
documentation => 'Rules to grant sessions',
},
@ -1058,7 +1057,7 @@ sub attributes {
type => 'keyTextContainer',
help =>
'exportedvars.html#extend_variables_using_macros_and_groups',
test => $perlExpr,
test => sub { return perlExpr(@_) },
default => {},
documentation => 'Groups',
},
@ -1068,7 +1067,7 @@ sub attributes {
'exportedvars.html#extend_variables_using_macros_and_groups',
keyTest => qr/^[_a-zA-Z][a-zA-Z0-9_]*$/,
keyMsgFail => '__badMacroName__',
test => $perlExpr,
test => sub { return perlExpr(@_) },
default => {},
documentation => 'Macros',
},
@ -1373,6 +1372,7 @@ sub attributes {
type => 'int',
documentation => 'U2F device time to live',
},
# TOTP second factor
totp2fActivation => {
type => 'boolOrExpr',
@ -1697,17 +1697,7 @@ sub attributes {
: ( 0, '__badUrl__' );
}
$s =~ s/\b(accept|deny|unprotect|skip)\b/1/g;
my $cpt = new Safe;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
return &perlExpr( $s, $conf );
},
msgFail => '__badExpression__',
},
@ -1725,21 +1715,7 @@ sub attributes {
test => {
keyTest => qr/^(?=[^\-])[\w\-]+(?<=[^-])$/,
keyMsgFail => '__badHeaderName__',
test => sub {
my ( $val, $conf ) = @_;
my $s = $val;
my $cpt = new Safe;
$cpt->share_from( 'MIME::Base64', ['&encode_base64'] );
$cpt->share_from( 'Lemonldap::NG::Handler::Main::Jail',
[ '&encrypt', '&token' ] );
$cpt->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$cpt->reval("BEGIN { warnings->unimport; } $s");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
}
test => sub { return perlExpr(@_) },
},
documentation => 'Virtualhost headers',
flags => 'h',
@ -1909,7 +1885,7 @@ sub attributes {
},
casAppMetaDataOptionsRule => {
type => 'text',
test => $perlExpr,
test => sub { return perlExpr(@_) },
documentation => 'CAS App rule',
},
@ -2513,7 +2489,7 @@ sub attributes {
},
samlSPMetaDataOptionsRule => {
type => 'text',
test => $perlExpr,
test => sub { return perlExpr(@_) },
documentation => 'Rule to grant access to this SP',
},
@ -3503,7 +3479,7 @@ m{^(?:ldapi://[^/]*/?|\w[\w\-\.]*(?::\d{1,5})?|ldap(?:s|\+tls)?://\w[\w\-\.]*(?:
},
oidcRPMetaDataOptionsRule => {
type => 'text',
test => $perlExpr,
test => sub { return perlExpr(@_) },
documentation => 'Rule to grant access to this RP',
},
};