LDAP extensible match support (EJAB-722)

src/eldap/Makefile.in

@@ -1,4 +1,4 @@
-# $Id$
+# $Id: Makefile.in 2842 2009-12-29 19:10:52Z badlop $
 
 CC = @CC@
 CFLAGS = @CFLAGS@
@@ -20,18 +20,23 @@ ifdef debug
 endif
 
 OUTDIR = ..
-SOURCES = $(wildcard *.erl) ELDAPv3.erl
+SOURCES = $(wildcard *.erl) ELDAPv3.erl eldap_filter_yecc.erl
 BEAMS = $(addprefix $(OUTDIR)/,$(SOURCES:.erl=.beam))
 
 
-all:    $(BEAMS) ELDAPv3.beam
+all:    $(BEAMS) ELDAPv3.beam eldap_filter_yecc.beam
 
 ELDAPv3.beam: ELDAPv3.erl
 
 ELDAPv3.erl:       ELDAPv3.asn
 	@ERLC@ $(ASN_FLAGS) -W $(EFLAGS) $<
 
-$(OUTDIR)/%.beam:	%.erl ELDAPv3.erl
+eldap_filter_yecc.beam: eldap_filter_yecc.erl
+
+eldap_filter_yecc.erl: eldap_filter_yecc.yrl
+	@ERLC@ -W $<
+
+$(OUTDIR)/%.beam:	%.erl ELDAPv3.erl eldap_filter_yecc.erl
 	@ERLC@ -W $(EFLAGS) -o $(OUTDIR) $<
 
 clean:
@@ -39,6 +44,8 @@ clean:
 	rm -f ELDAPv3.erl
 	rm -f ELDAPv3.hrl
 	rm -f ELDAPv3.beam
+	rm -f eldap_filter_yecc.erl
+	rm -f eldap_filter_yecc.beam
 	rm -f $(BEAMS)
 
 distclean: clean
@@ -47,7 +54,6 @@ distclean: clean
 TAGS:
 	etags *.erl
 
-
 # Don't include ELDAPv3.erl in sources for Devdoc
 SOURCES = eldap.erl eldap_filter.erl eldap.hrl eldap_pool.erl eldap_utils.erl
 

src/eldap/Makefile.win32

@@ -4,7 +4,7 @@ include ..\Makefile.inc
 EFLAGS = -I .. -pz ..
 
 OUTDIR = ..
-BEAMS = ..\eldap.beam ..\eldap_filter.beam ..\eldap_pool.beam ..\eldap_utils.beam
+BEAMS = ..\eldap.beam ..\eldap_filter.beam ..\eldap_pool.beam ..\eldap_utils.beam ..\eldap_filter_yecc.beam
 
 ASN_FLAGS = -bber_bin +optimize +driver
 
@@ -15,11 +15,16 @@ Clean :
 	-@erase ELDAPv3.erl
 	-@erase ELDAPv3.hrl
 	-@erase ELDAPv3.beam
+	-@erase eldap_filter_yecc.erl
+	-@erase eldap_filter_yecc.beam
 	-@erase $(BEAMS)
 
 ELDAPv3.erl : ELDAPv3.asn
 	erlc $(ASN_FLAGS) -W $(EFLAGS) ELDAPv3.asn
 
+eldap_filter_yecc.erl: eldap_filter_yecc.yrl
+	erlc -W eldap_filter_yecc.yrl
+
 $(OUTDIR)\eldap.beam : eldap.erl ELDAPv3.erl
 	erlc -W $(EFLAGS) -o $(OUTDIR) eldap.erl
 
@@ -34,3 +39,6 @@ $(OUTDIR)\eldap_utils.beam : eldap_utils.erl
 
 $(OUTDIR)\eldap_pool.beam : eldap_pool.erl
 	erlc -W $(EFLAGS) -o $(OUTDIR) eldap_pool.erl
+
+$(OUTDIR)\eldap_filter_yecc.beam : eldap_filter_yecc.erl
+	erlc -W $(EFLAGS) -o $(OUTDIR) eldap_filter_yecc.erl

src/eldap/eldap.erl

@@ -35,6 +35,7 @@
 
 %%% Modified by Evgeniy Khramtsov <xram@jabber.ru>
 %%% Implemented queue for bind() requests to prevent pending binds.
+%%% Implemented extensibleMatch/2 function.
 
 %%% Modified by Christophe Romain <christophe.romain@process-one.net>
 %%% Improve error case handling
@@ -71,7 +72,7 @@
 
 -export([baseObject/0,singleLevel/0,wholeSubtree/0,close/1,
 	 equalityMatch/2,greaterOrEqual/2,lessOrEqual/2,
-	 approxMatch/2,search/2,substrings/2,present/1,
+	 approxMatch/2,search/2,substrings/2,present/1,extensibleMatch/2,
 	 'and'/1,'or'/1,'not'/1,modify/3, mod_add/2, mod_delete/2,
 	 mod_replace/2, add/3, delete/2, modify_dn/5, bind/3]).
 -export([get_status/1]).
@@ -374,6 +375,29 @@ substrings(Type, SubStr) when is_list(Type), is_list(SubStr) ->
     {substrings,#'SubstringFilter'{type = Type,
 				   substrings = Ss}}.
 
+%%%
+%%% extensibleMatch filter.
+%%% FIXME: Describe the purpose of this filter.
+%%%
+%%% Value   ::= string( <attribute> )
+%%% Opts    ::= listof( {matchingRule, Str} | {type, Str} | {dnAttributes, true} )
+%%%
+%%% Example: extensibleMatch("Fred", [{matchingRule, "1.2.3.4.5"}, {type, "cn"}]).
+%%%
+extensibleMatch(Value, Opts) when is_list(Value), is_list(Opts) ->
+	MRA = #'MatchingRuleAssertion'{matchValue=Value},
+	{extensibleMatch, extensibleMatch_opts(Opts, MRA)}.
+
+extensibleMatch_opts([{matchingRule, Rule} | Opts], MRA) when is_list(Rule) ->
+	extensibleMatch_opts(Opts, MRA#'MatchingRuleAssertion'{matchingRule=Rule});
+extensibleMatch_opts([{type, Desc} | Opts], MRA) when is_list(Desc) ->
+	extensibleMatch_opts(Opts, MRA#'MatchingRuleAssertion'{type=Desc});
+extensibleMatch_opts([{dnAttributes, true} | Opts], MRA) ->
+	extensibleMatch_opts(Opts, MRA#'MatchingRuleAssertion'{dnAttributes=true});
+extensibleMatch_opts([_ | Opts], MRA) ->
+	extensibleMatch_opts(Opts, MRA);
+extensibleMatch_opts([], MRA) ->
+	MRA.
 
 get_handle(Pid) when is_pid(Pid)    -> Pid;
 get_handle(Atom) when is_atom(Atom) -> Atom;
@@ -973,6 +997,8 @@ v_filter({lessOrEqual,AV})    -> {lessOrEqual,AV};
 v_filter({approxMatch,AV})    -> {approxMatch,AV};
 v_filter({present,A})         -> {present,A};
 v_filter({substrings,S}) when is_record(S,'SubstringFilter') -> {substrings,S};
+v_filter({extensibleMatch, S}) when is_record(S, 'MatchingRuleAssertion') ->
+    {extensibleMatch, S};
 v_filter(_Filter) -> throw({error,concat(["unknown filter: ",_Filter])}).
 
 v_modifications(Mods) ->

src/eldap/eldap_filter.erl

@@ -3,7 +3,7 @@
 %%% Purpose: Converts String Representation of
 %%%            LDAP Search Filter (RFC 2254)
 %%%            to eldap's representation of filter
-%%% Author:  Evgeniy Khramtsov <xramtsov@gmail.com>
+%%% Author:  Evgeniy Khramtsov <ekhramtsov@process-one.net>
 %%%
 %%%
 %%% ejabberd, Copyright (C) 2002-2010   ProcessOne
@@ -24,19 +24,14 @@
 %%% 02111-1307 USA
 %%%
 %%%----------------------------------------------------------------------
-
 -module(eldap_filter).
 
-%%%======================
+-export([parse/1, parse/2, do_sub/2]).
-%%% Export functions
-%%%======================
 
--export([parse/1,
+%%====================================================================
-	 parse/2,
+%% API
-	 do_sub/2
+%%====================================================================
-	]).
+%%%-------------------------------------------------------------------
-
-%%%-------------------------------------------------------------------------
 %%% Arity: parse/1
 %%% Function: parse(RFC2254_Filter) -> {ok, EldapFilter}   |
 %%%                                    {error, bad_filter}
@@ -47,15 +42,15 @@
 %%%              to eldap's representation of filter.
 %%%
 %%% Example:
-%%%    > eldap_filter:parse("(&(!(uid<=100))(mail=*))").
+%%%   > eldap_filter:parse("(&(!(uid<=100))(mail=*))").
 %%%
-%%%    {ok,{'and',[{'not',{lessOrEqual,{'AttributeValueAssertion',"uid","100"}}},
+%%%   {ok,{'and',[{'not',{lessOrEqual,{'AttributeValueAssertion',"uid","100"}}},
-%%%            {present,"mail"}]}}
+%%%           {present,"mail"}]}}
-%%%-------------------------------------------------------------------------
+%%%-------------------------------------------------------------------
-parse(RFC2254_Filter) ->
+parse(L) when is_list(L) ->
-    parse(RFC2254_Filter, []).
+    parse(L, []).
 
-%%%-------------------------------------------------------------------------
+%%%-------------------------------------------------------------------
 %%% Arity: parse/2
 %%% Function: parse(RFC2254_Filter, [SubstValue |...]) ->
 %%%                                  {ok, EldapFilter}                 |
@@ -81,135 +76,53 @@ parse(RFC2254_Filter) ->
 %%%           {equalityMatch,{'AttributeValueAssertion',
 %%%                              "jid",
 %%%                              "xramtsov@gmail.com"}}]}}
-%%%--------------------------------------------------------------------------
+%%%-------------------------------------------------------------------
-parse(RFC2254_Filter, ListOfSubValues) ->
+parse(L, SList) when is_list(L), is_list(SList) ->
-    case catch convert_filter(parse_filter(RFC2254_Filter), ListOfSubValues) of
+    case catch eldap_filter_yecc:parse(scan(L, SList)) of
-	[EldapFilter] when is_tuple(EldapFilter) ->
+	{error, {_, _, Msg}} ->
-	    {ok, EldapFilter};
+	    {error, Msg};
-	{regexp, Error} ->
+	{ok, Result} ->
-	    {error, Error};
+	    {ok, Result};
-	_ ->
+	{regexp, Err} ->
-	    {error, bad_filter}
+	    {error, Err}
     end.
 
-%%%==========================
+%%====================================================================
-%%% Internal functions
+%% Internal functions
-%%%==========================
+%%====================================================================
+-define(do_scan(L), scan(Rest, [], [{L, 1} | check(Buf, S) ++ Result], L, S)).
 
-%%%----------------------
+scan(L, SList) ->
-%%% split/1,4
+    scan(L, "", [], undefined, SList).
-%%%----------------------
-split(Filter) ->
-    split(Filter, 0, [], []).
 
-split([], _, _, Result) ->
+scan("=*)" ++ Rest, Buf, Result, '(', S) ->
-    Result;
+    scan(Rest, [], [{')', 1}, {'=*', 1} | check(Buf, S) ++ Result], ')', S);
+scan(":dn" ++ Rest, Buf, Result, '(', S) -> ?do_scan(':dn');
+scan(":=" ++ Rest, Buf, Result, '(', S) -> ?do_scan(':=');
+scan(":=" ++ Rest, Buf, Result, ':dn', S) -> ?do_scan(':=');
+scan(":=" ++ Rest, Buf, Result, ':', S) -> ?do_scan(':=');
+scan("~=" ++ Rest, Buf, Result, '(', S) -> ?do_scan('~=');
+scan(">=" ++ Rest, Buf, Result, '(', S) -> ?do_scan('>=');
+scan("<=" ++ Rest, Buf, Result, '(', S) -> ?do_scan('<=');
+scan("="  ++ Rest, Buf, Result, '(', S) -> ?do_scan('=');
+scan(":"  ++ Rest, Buf, Result, '(', S) -> ?do_scan(':');
+scan(":"  ++ Rest, Buf, Result, ':dn', S) -> ?do_scan(':');
+scan("&"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('&');
+scan("|"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('|');
+scan("!"  ++ Rest, Buf, Result, '(', S) when Buf=="" -> ?do_scan('!');
+scan("*"  ++ Rest, Buf, Result, '*', S) -> ?do_scan('*');
+scan("*"  ++ Rest, Buf, Result, '=', S) -> ?do_scan('*');
+scan("("  ++ Rest, Buf, Result, _, S) -> ?do_scan('(');
+scan(")"  ++ Rest, Buf, Result, _, S) -> ?do_scan(')');
+scan([Letter | Rest], Buf, Result, PreviosAtom, S) ->
+    scan(Rest, [Letter|Buf], Result, PreviosAtom, S);
+scan([], Buf, Result, _, S) ->
+    lists:reverse(check(Buf, S) ++ Result).
 
-split([H|T], Num, Rest, Result) ->
+check([], _) ->
-    NewNum = case H of
+    [];
-		 $( -> Num + 1;
+check(Buf, S) ->
-		    $) -> Num - 1;
+    [{str, 1, do_sub(lists:reverse(Buf), S)}].
-		 _ -> Num
-	     end,
-    if
-	NewNum == 0 ->
-	    X = Rest++[H],
-	    LenX = length(X),
-	    if
-		LenX > 2 ->
-		    split(T, 0, [], Result ++ [lists:sublist(X, 2, LenX-2)]);
-		true ->
-		    split(T, 0, Rest, Result)
-	    end;
-	true ->
-	    split(T, NewNum, Rest++[H], Result)
-    end.
-
-%%%-----------------------
-%%% parse_filter/1
-%%%-----------------------
-parse_filter(Filter) ->
-    case Filter of
-	[$! | T] ->
-	    {'not', parse_filter(T)};
-	[$| | T] ->
-	    {'or', parse_filter(T)};
-	[$& | T] ->
-	    {'and', parse_filter(T)};
-	[$( | _] ->
-		parse_filter(split(Filter));
-	[List | _] when is_list(List) ->
-	    [parse_filter(X) || X <- Filter];
-	_ ->
-	    Filter
-    end.
-
-%%%--------------------
-%%% convert_filter/2
-%%%--------------------
-convert_filter({'not', [Val | _]}, Replace) ->
-    eldap:'not'(convert_filter(Val, Replace));
-
-convert_filter({'or', Vals}, Replace) ->
-    eldap:'or'([convert_filter(X, Replace) || X <- Vals]);
-
-convert_filter({'and', Vals}, Replace) ->
-    eldap:'and'([convert_filter(X, Replace) || X <- Vals]);
-
-convert_filter([H|_] = Filter, Replace) when is_integer(H) ->
-    parse_attr(Filter, Replace);
-
-convert_filter(Filter, Replace) when is_list(Filter) ->
-    [convert_filter(X, Replace) || X <- Filter].
-
-%%%-----------------
-%%% parse_attr/2,3
-%%%-----------------
-parse_attr(Attr, ListOfSubValues) ->
-    {Action, [_|_] = Name, [_|_] = Value} = split_attribute(Attr),
-    parse_attr(Action, {Name, Value}, ListOfSubValues).
-
-parse_attr(approx, {Name, Value}, ListOfSubValues) ->
-    NewValue = do_sub(Value, ListOfSubValues),
-    eldap:approxMatch(Name, NewValue);
-
-parse_attr(greater, {Name, Value}, ListOfSubValues) ->
-    NewValue = do_sub(Value, ListOfSubValues),
-    eldap:greaterOrEqual(Name, NewValue);
-
-parse_attr(less, {Name, Value}, ListOfSubValues) ->
-    NewValue = do_sub(Value, ListOfSubValues),
-    eldap:lessOrEqual(Name, NewValue);
-
-parse_attr(equal, {Name, Value}, ListOfSubValues) ->
-    RegSList = re:split(remove_extra_asterisks(Value), "[*]", [{return, list}]),
-    Pattern = case [do_sub(X, ListOfSubValues) || X <- RegSList] of
-		  [Head | Tail] when Tail /= [] ->
-		      {Head, lists:sublist(Tail, length(Tail)-1), lists:last(Tail)};
-		  R ->
-		      R
-	      end,
-    case Pattern of
-	[V] ->
-	    eldap:equalityMatch(Name, V);
-	{[], [], []} ->
-	    eldap:present(Name);
-	{"", Any, ""} ->
-	    eldap:substrings(Name, [{any, X} || X<-Any]);
-	{H, Any, ""} ->
-	    eldap:substrings(Name, [{initial, H}]++[{any, X} || X<-Any]);
-	{"", Any, T} ->
-	    eldap:substrings(Name, [{any, X} || X<-Any]++[{final, T}]);
-	{H, Any, T} ->
-	    eldap:substrings(Name, [{initial, H}]++[{any, X} || X<-Any]++[{final, T}])
-    end;
-
-parse_attr(_, _, _) ->
-    false.
-
-%%%--------------------
-%%% do_sub/2,3
-%%%--------------------
 
 -define(MAX_RECURSION, 100).
 
@@ -256,49 +169,8 @@ do_sub(S, {RegExp, New, Times}, Iter) ->
 	    throw({regexp, bad_regexp})
     end.
 
-remove_extra_asterisks(String) ->
-    {Res, _} = lists:foldl(
-		 fun(X, {Acc, Last}) ->
-			 case X of
-			     $* when Last==$* ->
-				 {Acc, X};
-			     _ ->
-				 {Acc ++ [X], X}
-			 end
-		 end,
-		 {"", ""}, String),
-    Res.
-
 replace_amps(String) ->
-	lists:foldl(
+    lists:map(
-		fun(X, Acc) ->
+      fun($&) -> "\\&";
-			if
+	 (Chr) -> Chr
-				X == $& ->
+      end, String).
-					Acc ++ "\\&";
-				true ->
-					Acc ++ [X]
-			end
-		end,
-	"", String).
-
-split_attribute(String) ->
-    split_attribute(String, "", $0).
-
-split_attribute([], _, _) ->
-    {error, "", ""};
-
-split_attribute([H|Tail], Acc, Last) ->
-    case H of
-	$= when Last==$> ->
-	    {greater, lists:sublist(Acc, 1, length(Acc)-1), Tail};
-	$= when Last==$< ->
-	    {less, lists:sublist(Acc, 1, length(Acc)-1), Tail};
-	$= when Last==$~ ->
-	    {approx, lists:sublist(Acc, 1, length(Acc)-1), Tail};
-	$= when Last==$: ->
-	    {equal, lists:sublist(Acc, 1, length(Acc)-1), Tail};
-	$= ->
-	    {equal, Acc, Tail};
-	_ ->
-	    split_attribute(Tail, Acc++[H], H)
-    end.

src/eldap/eldap_filter_yecc.yrl

@@ -0,0 +1,71 @@
+Nonterminals
+filter filtercomp filterlist item
+simple present substring extensible
+initial any final matchingrule xattr
+attr value.
+
+Terminals str
+'(' ')' '&' '|' '!' '=' '~=' '>=' '<=' '=*' '*' ':dn' ':' ':='.
+
+Rootsymbol filter.
+
+filter -> '(' filtercomp ')': '$2'.
+filtercomp -> '&' filterlist: 'and'('$2').
+filtercomp -> '|' filterlist: 'or'('$2').
+filtercomp -> '!' filter: 'not'('$2').
+filtercomp -> item: '$1'.
+filterlist -> filter: '$1'.
+filterlist -> filter filterlist: flatten(['$1', '$2']).
+
+item -> simple: '$1'.
+item -> present: '$1'.
+item -> substring: '$1'.
+item -> extensible: '$1'.
+
+simple -> attr '=' value: equal('$1', '$3').
+simple -> attr '~=' value: approx('$1', '$3').
+simple -> attr '>=' value: greater('$1', '$3').
+simple -> attr '<=' value: less('$1', '$3').
+
+present -> attr '=*': present('$1').
+
+substring -> attr '=' initial '*' any: substrings('$1', ['$3', '$5']).
+substring -> attr '=' '*' any final: substrings('$1', ['$4', '$5']).
+substring -> attr '=' initial '*' any final: substrings('$1', ['$3', '$5', '$6']).
+substring -> attr '=' '*' any: substrings('$1', ['$4']).
+any -> any value '*': 'any'('$1', '$2').
+any -> '$empty': [].
+initial -> value: initial('$1').
+final -> value: final('$1').
+
+extensible -> xattr ':dn' ':' matchingrule ':=' value: extensible('$6', ['$1', '$4']).
+extensible -> xattr ':' matchingrule ':=' value: extensible('$5', ['$1', '$3']).
+extensible -> xattr ':dn' ':=' value: extensible('$4', ['$1']).
+extensible -> xattr ':=' value: extensible('$3', ['$1']).
+extensible -> ':dn' ':' matchingrule ':=' value: extensible('$5', ['$3']).
+extensible -> ':' matchingrule ':=' value: extensible('$4', ['$2']).
+xattr -> value: xattr('$1').
+matchingrule -> value: matchingrule('$1').
+
+attr -> str: value_of('$1').
+value -> str: value_of('$1').
+
+Erlang code.
+
+'and'(Value)                -> eldap:'and'(Value).
+'or'(Value)                 -> eldap:'or'(Value).
+'not'(Value)                -> eldap:'not'(Value).
+equal(Desc, Value)          -> eldap:equalityMatch(Desc, Value).
+approx(Desc, Value)         -> eldap:approxMatch(Desc, Value).
+greater(Desc, Value)        -> eldap:greaterOrEqual(Desc, Value).
+less(Desc, Value)           -> eldap:lessOrEqual(Desc, Value).
+present(Value)              -> eldap:present(Value).
+extensible(Value, Opts)     -> eldap:extensibleMatch(Value, Opts).
+substrings(Desc, ValueList) -> eldap:substrings(Desc, flatten(ValueList)).
+initial(Value)              -> {initial, Value}.
+final(Value)                -> {final, Value}.
+'any'(Token, Value)         -> [Token, {any, Value}].
+xattr(Value)                -> {type, Value}.
+matchingrule(Value)         -> {matchingRule, Value}.
+value_of(Token)             -> element(3, Token).
+flatten(List)               -> lists:flatten(List).