Combination parser (#1151)
This commit is contained in:
parent
6040f03671
commit
7a675d14ca
|
@ -11,6 +11,7 @@ lib/Lemonldap/NG/Common/Apache/Session/Store.pm
|
||||||
lib/Lemonldap/NG/Common/Captcha.pm
|
lib/Lemonldap/NG/Common/Captcha.pm
|
||||||
lib/Lemonldap/NG/Common/CGI.pm
|
lib/Lemonldap/NG/Common/CGI.pm
|
||||||
lib/Lemonldap/NG/Common/Cli.pm
|
lib/Lemonldap/NG/Common/Cli.pm
|
||||||
|
lib/Lemonldap/NG/Common/CombinationParser.pm
|
||||||
lib/Lemonldap/NG/Common/Conf.pm
|
lib/Lemonldap/NG/Common/Conf.pm
|
||||||
lib/Lemonldap/NG/Common/Conf/AccessLib.pm
|
lib/Lemonldap/NG/Common/Conf/AccessLib.pm
|
||||||
lib/Lemonldap/NG/Common/Conf/Backends/_DBI.pm
|
lib/Lemonldap/NG/Common/Conf/Backends/_DBI.pm
|
||||||
|
|
192
lemonldap-ng-common/lib/Lemonldap/NG/Common/CombinationParser.pm
Normal file
192
lemonldap-ng-common/lib/Lemonldap/NG/Common/CombinationParser.pm
Normal file
|
@ -0,0 +1,192 @@
|
||||||
|
package Lemonldap::NG::Common::CombinationParser;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Mouse;
|
||||||
|
use constant PE_OK => 0;
|
||||||
|
|
||||||
|
# Handle "if then else" (used during init)
|
||||||
|
# return a sub that can be called with ($req) to get a [array] of combination
|
||||||
|
#
|
||||||
|
# During auth, these combinations represents "or" (like Multi)
|
||||||
|
# Each combination is a [authSub,userSub] called like this:
|
||||||
|
# $authSub->('authenticate',$req)
|
||||||
|
# This means that the 'authenticate' method of the real auth module will be
|
||||||
|
# called with $req
|
||||||
|
|
||||||
|
sub parse {
|
||||||
|
my ( $self, $moduleList, $expr ) = @_;
|
||||||
|
|
||||||
|
my $sub = '';
|
||||||
|
my $rest = $expr;
|
||||||
|
if ( $rest =~ s/^\s*if\s*\(// ) {
|
||||||
|
my ( $cond, $then, $else );
|
||||||
|
( $cond, $rest ) = $self->findB( $rest, ')' );
|
||||||
|
unless ($cond) {
|
||||||
|
$self->lmLog( 'Bad combination: unmatched bracket', 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
unless ( $rest =~ s/\s*then\s*\{// ) {
|
||||||
|
$self->lmLog( 'Bad combination: missing "then"', 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
( $then, $rest ) = $self->findB( $rest, '}' );
|
||||||
|
unless ($then) {
|
||||||
|
$self->lmLog( 'Bad combination: missing "then" content', 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
unless ( $rest =~ s/\s*else\s*\{// ) {
|
||||||
|
$self->lmLog( 'Bad combination: missing "else"', 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
( $else, $rest ) = $self->findB( $rest, '}' );
|
||||||
|
unless ($else) {
|
||||||
|
$self->lmLog( 'Bad combination: missing "else" content', 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
if ( $rest !~ /^\s*$/ ) {
|
||||||
|
$self->lmLog( 'Bad combination: trailing characters after else{}',
|
||||||
|
'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
#TODO:
|
||||||
|
#$cond = HANDLER->buildSub($cond);
|
||||||
|
$cond = sub { 1 };
|
||||||
|
$then = $self->parse( $moduleList, $then );
|
||||||
|
$else = $self->parse( $moduleList, $else );
|
||||||
|
unless ( $then and $else ) {
|
||||||
|
$self->lmLog('Bad combination: bad then or else');
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
return sub {
|
||||||
|
my ( $sub, $req ) = @_;
|
||||||
|
return [
|
||||||
|
( $cond->($req) ? $then->[0]->($@) : $else->[0]->($@) ),
|
||||||
|
( $cond->($req) ? $then->[1]->($@) : $else->[1]->($@) ),
|
||||||
|
];
|
||||||
|
};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $res = $self->parseOr( $moduleList, $rest );
|
||||||
|
return sub { $res };
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Internal request to manage "or" boolean expr.
|
||||||
|
# Returns [ [authSub,userSub], [authSub,userSub] ] array
|
||||||
|
sub parseOr {
|
||||||
|
my ( $self, $moduleList, $expr ) = @_;
|
||||||
|
my @res;
|
||||||
|
foreach my $part ( split /\s+or\s+/, $expr ) {
|
||||||
|
push @res, $self->parseAnd( $moduleList, $part );
|
||||||
|
}
|
||||||
|
return \@res;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Internal request to manage "and" boolean expr
|
||||||
|
# Returns [authSub,userSub] array
|
||||||
|
sub parseAnd {
|
||||||
|
my ( $self, $moduleList, $expr ) = @_;
|
||||||
|
if ( $expr =~ /\]\s*and\s*\[/ ) {
|
||||||
|
my @mod = ( [], [] );
|
||||||
|
foreach my $part ( split /\]\s*and\s*\[/, $expr ) {
|
||||||
|
my $tmp = $self->parseBlock( $moduleList, $part );
|
||||||
|
push @{ $mod[0] }, $tmp->[0];
|
||||||
|
push @{ $mod[1] }, $tmp->[1];
|
||||||
|
}
|
||||||
|
my @res;
|
||||||
|
foreach my $type (@mod) {
|
||||||
|
push @res, sub {
|
||||||
|
foreach my $obj (@$type) {
|
||||||
|
my $r = $obj->(@_);
|
||||||
|
return $r unless ( $r == PE_OK );
|
||||||
|
}
|
||||||
|
return PE_OK;
|
||||||
|
};
|
||||||
|
}
|
||||||
|
return \@res;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return $self->parseBlock( $moduleList, $expr );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Internal method to parse [AuthModule,UserModule] expr
|
||||||
|
# Returns [authSub,userSub] array
|
||||||
|
sub parseBlock {
|
||||||
|
my ( $self, $moduleList, $expr ) = @_;
|
||||||
|
unless ( $expr =~ /^\s*\[(.*?)\s*(?:,\s*(.*?))?\s*\]\s*$/ ) {
|
||||||
|
die "Bad expression: $expr";
|
||||||
|
}
|
||||||
|
my @res = ( $1, $2 || $1 );
|
||||||
|
@res = map { $self->parseMod( $moduleList, $_ ) } @res;
|
||||||
|
return \@res;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Internal method to parse auth or userDB expr
|
||||||
|
# These expressions can be "LDAP" or "LDAP and DBI"
|
||||||
|
# Return sub
|
||||||
|
sub parseMod {
|
||||||
|
my ( $self, $moduleList, $expr ) = @_;
|
||||||
|
my @mods = map {
|
||||||
|
die "Unknown module $_"
|
||||||
|
unless ( $moduleList->{$_} );
|
||||||
|
$moduleList->{$_}
|
||||||
|
} split( /\s+and\s+/, $expr );
|
||||||
|
if ( @mods == 1 ) {
|
||||||
|
my ($m) = @mods;
|
||||||
|
return sub {
|
||||||
|
my ( $sub, $req ) = @_;
|
||||||
|
return $m->$sub($req);
|
||||||
|
};
|
||||||
|
}
|
||||||
|
return sub {
|
||||||
|
my ( $sub, $req ) = @_;
|
||||||
|
foreach my $obj (@mods) {
|
||||||
|
my $res = $obj->$sub($req);
|
||||||
|
return $res unless ( $res == PE_OK );
|
||||||
|
}
|
||||||
|
return PE_OK;
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
# Internal request to find brackets
|
||||||
|
sub findB {
|
||||||
|
my ( $self, $expr, $char ) = @_;
|
||||||
|
my $res;
|
||||||
|
my @chars = split //, $expr;
|
||||||
|
while ( my $c = shift @chars ) {
|
||||||
|
if ( $c eq "\\" ) {
|
||||||
|
$res .= $c . shift(@chars);
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
if ( $c eq $char ) {
|
||||||
|
my $rest = join( '', @chars );
|
||||||
|
$res =~ s/^\s*(.*?)\s*/$1/;
|
||||||
|
$rest =~ s/^\s*(.*?)\s*/$1/;
|
||||||
|
return ( $res, $rest );
|
||||||
|
}
|
||||||
|
if ( $c =~ /^(?:\(|\{|\[|'|")$/ ) {
|
||||||
|
my $wanted = {
|
||||||
|
'(' => ')',
|
||||||
|
'{' => '}',
|
||||||
|
'[' => ']',
|
||||||
|
"'" => "'",
|
||||||
|
'"' => '"'
|
||||||
|
}->{$c};
|
||||||
|
my ( $m, $rest ) =
|
||||||
|
$self->findB( join( '', @chars ), $wanted );
|
||||||
|
unless ($m) {
|
||||||
|
$self->lmLog( "Bad combination: unmatched $c", 'error' );
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
$res .= "$c$m$wanted";
|
||||||
|
@chars = split //, $rest;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
$res .= $c;
|
||||||
|
}
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
Loading…
Reference in New Issue
Block a user