diff --git a/lemonldap-ng-common/MANIFEST b/lemonldap-ng-common/MANIFEST index e34d9ba22..370fee20a 100644 --- a/lemonldap-ng-common/MANIFEST +++ b/lemonldap-ng-common/MANIFEST @@ -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 diff --git a/lemonldap-ng-common/lib/Lemonldap/NG/Common/CombinationParser.pm b/lemonldap-ng-common/lib/Lemonldap/NG/Common/CombinationParser.pm new file mode 100644 index 000000000..eee16b208 --- /dev/null +++ b/lemonldap-ng-common/lib/Lemonldap/NG/Common/CombinationParser.pm @@ -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;