Commit 7a675d14 authored by Xavier Guimard's avatar Xavier Guimard

Combination parser (#1151)

parent 6040f036
......@@ -11,6 +11,7 @@ lib/Lemonldap/NG/Common/Apache/Session/Store.pm
lib/Lemonldap/NG/Common/Captcha.pm
lib/Lemonldap/NG/Common/CGI.pm
lib/Lemonldap/NG/Common/Cli.pm
lib/Lemonldap/NG/Common/CombinationParser.pm
lib/Lemonldap/NG/Common/Conf.pm
lib/Lemonldap/NG/Common/Conf/AccessLib.pm
lib/Lemonldap/NG/Common/Conf/Backends/_DBI.pm
......
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;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment