./ct_report/coverage/eldap_utils.COVER.html

1 %%%----------------------------------------------------------------------
2 %%% File : eldap_utils.erl
3 %%% Author : Mickael Remond <mremond@process-one.net>
4 %%% Purpose : ejabberd LDAP helper functions
5 %%% Created : 12 Oct 2006 by Mickael Remond <mremond@process-one.net>
6 %%%
7 %%%
8 %%% ejabberd, Copyright (C) 2002-2013 ProcessOne
9 %%%
10 %%% This program is free software; you can redistribute it and/or
11 %%% modify it under the terms of the GNU General Public License as
12 %%% published by the Free Software Foundation; either version 2 of the
13 %%% License, or (at your option) any later version.
14 %%%
15 %%% This program is distributed in the hope that it will be useful,
16 %%% but WITHOUT ANY WARRANTY; without even the implied warranty of
17 %%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 %%% General Public License for more details.
19 %%%
20 %%% You should have received a copy of the GNU General Public License
21 %%% along with this program; if not, write to the Free Software
22 %%% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
23 %%%
24 %%%----------------------------------------------------------------------
25
26 -module(eldap_utils).
27 -author('mremond@process-one.net').
28
29 -export([generate_subfilter/1,
30 find_ldap_attrs/2,
31 get_ldap_attr/2,
32 get_user_part/2,
33 make_filter/2,
34 make_filter/3,
35 get_state/2,
36 case_insensitive_match/2,
37 deref_aliases/1,
38 process_user_filter/2,
39 get_search_filter/1,
40 decode_octet_string/3,
41 uids_domain_subst/2,
42 singleton_value/1,
43 maybe_list2b/1,
44 maybe_b2list/1]).
45
46 -ignore_xref([decode_octet_string/3, generate_subfilter/1, make_filter/2, uids_domain_subst/2]).
47
48 -type dn() :: binary().
49 -type deref() :: neverDerefAliases | derefInSearching
50 | derefFindingBaseObj | derefAlways.
51 %% Used to access mongoose_wpool
52 -type eldap_id() :: {HostType :: mongooseim:host_type(), Tag :: mongoose_wpool:tag()}.
53
54 -export_type([dn/0,
55 deref/0,
56 eldap_id/0]).
57
58 %% @doc Generate an 'or' LDAP query on one or several attributes
59 %% If there is only one attribute
60 -spec generate_subfilter([{binary()} | {binary(), binary()}]) -> binary().
61 generate_subfilter([UID]) ->
62 
:-(
 subfilter(UID);
63 %% If there is several attributes
64 generate_subfilter(UIDs) ->
65 
:-(
 iolist_to_binary(["(|", [subfilter(UID) || UID <- UIDs], ")"]).
66
67
68 %% @doc Subfilter for a single attribute
69 -spec subfilter({binary()} | {binary(), binary()}) -> binary().
70 subfilter({UIDAttr, UIDAttrFormat}) ->
71 %% The default UiDAttrFormat is %u
72 
:-(
 <<$(, UIDAttr/binary, $=, UIDAttrFormat/binary, $)>>;
73 subfilter({UIDAttr}) ->
74 %% The default UiDAttrFormat is <<"%u">>
75 
:-(
 <<$(, UIDAttr/binary, $=, "%u)">>.
76
77
78 %% @doc Not tail-recursive, but it is not very terribly.
79 %% It stops finding on the first not empty value.
80 -spec find_ldap_attrs([{binary()} | {binary(), binary()}],
81 [{binary(), [binary()]}]) -> <<>> | {binary(), binary()}.
82 find_ldap_attrs([{Attr} | Rest], Attributes) ->
83 
:-(
 find_ldap_attrs([{Attr, <<"%u">>} | Rest], Attributes);
84 find_ldap_attrs([{Attr, Format} | Rest], Attributes) ->
85 
:-(
 case get_ldap_attr(Attr, Attributes) of
86 Value when Value /= <<>>, Value /= [] ->
87 
:-(
 {Value, Format};
88 _ ->
89 
:-(
 find_ldap_attrs(Rest, Attributes)
90 end;
91 find_ldap_attrs([], _) ->
92 
:-(
 <<>>.
93
94
95 -spec get_ldap_attr(binary(), [{binary(), [binary()]}]) -> binary().
96 get_ldap_attr(LDAPAttr, Attributes) ->
97 
:-(
 Res = lists:filter(
98 fun({Name, _}) ->
99 
:-(
 case_insensitive_match(Name, LDAPAttr)
100 end, Attributes),
101 
:-(
 case singleton_value(Res) of
102 
:-(
 {_, Value} -> eldap_utils:maybe_list2b(Value);
103 
:-(
 _ -> <<>>
104 end.
105
106
107 -spec get_user_part(binary(), binary()) -> {ok, binary()} | {error, badmatch}.
108 get_user_part(String, Pattern) ->
109 
:-(
 F = fun(S, P) ->
110 
:-(
 {First, _} = binary:match(P, <<"%u">>),
111 
:-(
 TailLength = byte_size(P) - (First+1),
112 
:-(
 binary:part(S, First, byte_size(S)-TailLength-First+1)
113 end,
114 
:-(
 case catch F(String, Pattern) of
115 {'EXIT', _} ->
116 
:-(
 {error, badmatch};
117 Result ->
118 
:-(
 case catch re:replace(Pattern, <<"%u">>, Result, [global, {return, binary}]) of
119 {'EXIT', _} ->
120 
:-(
 {error, badmatch};
121 StringRes ->
122 
:-(
 case case_insensitive_match(StringRes, String) of
123 true ->
124 
:-(
 {ok, Result};
125 false ->
126 
:-(
 {error, badmatch}
127 end
128 end
129 end.
130
131
132 -spec generate_substring_list(binary())
133 -> [{'any', binary()} | {'final', binary()} | {'initial', binary()}].
134 generate_substring_list(Value)->
135 
:-(
 Splits = binary:split(Value, <<"*">>, [global]),
136 
:-(
 {Acc, S}=case Splits of
137 
:-(
 [<<"">>|T]->{[], maybe_b2list(T)};
138 
:-(
 [H|T]-> {[{initial, maybe_b2list(H)}], T}
139 end,
140 
:-(
 lists:reverse(generate_substring_list(S, Acc)).
141 generate_substring_list([<<"">>], Acc)->
142 
:-(
 Acc;
143 generate_substring_list([Last], Acc)->
144 
:-(
 [{final, Last}|Acc];
145 generate_substring_list([H|T], Acc)->
146 
:-(
 generate_substring_list(T, [{any, H}|Acc]).
147
148
149 -spec make_filter([{binary(), [binary()]}], [{binary(), binary()}]) -> any().
150 make_filter(Data, UIDs) ->
151 
:-(
 make_filter(Data, UIDs, 'and').
152
153 -spec make_filter([{binary(), [binary()]}], [{binary(), binary()}],
154 'or' | 'and') -> any().
155 make_filter(Data, UIDs, Op) ->
156 
:-(
 NewUIDs = [{U, eldap_filter:do_sub(
157 
:-(
 UF, [{<<"%u">>, <<"*%u*">>, 1}])} || {U, UF} <- UIDs],
158 
:-(
 Filter = lists:flatmap(
159 traverse_filter_fun(NewUIDs), Data),
160 
:-(
 case Filter of
161 [F] ->
162 
:-(
 F;
163 _ ->
164 
:-(
 eldap:Op(Filter)
165 end.
166
167 traverse_filter_fun(NewUIDs) ->
168 
:-(
 fun(Entry) ->
169 
:-(
 match_filter_name(Entry, NewUIDs)
170 end.
171
172 match_filter_name({<<"%u">>, [Value | _]}, NewUIDs) when Value /= <<"">> ->
173 
:-(
 case eldap_filter:parse(
174 generate_subfilter(NewUIDs),
175 [{<<"%u">>, Value}]) of
176 
:-(
 {ok, F} -> [F];
177 
:-(
 _ -> []
178 end;
179 match_filter_name({Name, [Value | _]}, _NewUIDs) when Value /= <<"">> ->
180 
:-(
 case binary:match(Value, <<"*">>) of
181 
:-(
 nomatch -> [eldap:equalityMatch(Name, Value)];
182 
:-(
 _ -> [eldap:substrings(maybe_b2list(Name),
183 generate_substring_list(Value))]
184 end;
185 match_filter_name(_, _) ->
186 
:-(
 [].
187
188 -spec case_insensitive_match(binary(), binary()) -> boolean().
189 case_insensitive_match(X, Y) ->
190 
:-(
 X1 = string:to_lower(maybe_b2list(X)),
191 
:-(
 Y1 = string:to_lower(maybe_b2list(Y)),
192 
:-(
 case X1 == Y1 of
193 
:-(
 true -> true;
194 
:-(
 _-> false
195 end.
196
197
198 -spec get_state(mongooseim:host_type(), atom()) -> any().
199 get_state(HostType, Module) ->
200 
:-(
 Proc = gen_mod:get_module_proc(HostType, Module),
201 
:-(
 gen_server:call(Proc, get_state).
202
203
204 %% @doc From the list of uids attribute: we look from alias domain (%d) and make
205 %% the substitution with the actual host domain. This helps when you need to
206 %% configure many virtual domains.
207 -spec uids_domain_subst(binary(), [{binary(), binary()}]) ->
208 [{binary(), binary()}].
209 uids_domain_subst(Host, UIDs) ->
210 
:-(
 lists:map(fun({U, V}) ->
211 
:-(
 {U, eldap_filter:do_sub(V, [{<<"%d">>, Host}])};
212 
:-(
 (A) -> A
213 end,
214 UIDs).
215
216 
:-(
 deref_aliases(never) -> neverDerefAliases;
217 
:-(
 deref_aliases(searching) -> derefInSearching;
218 
:-(
 deref_aliases(finding) -> derefFindingBaseObj;
219 
:-(
 deref_aliases(always) -> derefAlways.
220
221 process_user_filter(UIDs, RawUserFilter) ->
222 
:-(
 SubFilter = generate_subfilter(UIDs),
223 
:-(
 case RawUserFilter of
224 <<>> ->
225 
:-(
 SubFilter;
226 F ->
227 
:-(
 <<"(&", SubFilter/binary, F/binary, ")">>
228 end.
229
230 get_search_filter(UserFilter) ->
231 
:-(
 eldap_filter:do_sub(UserFilter, [{<<"%u">>, <<"*">>}]).
232
233 -spec singleton_value(list()) -> {binary(), binary()} | false.
234 singleton_value([{K, [V]}]) ->
235 
:-(
 {K, V};
236 singleton_value([{_K, _V} = I]) ->
237 
:-(
 I;
238 singleton_value(_) ->
239 
:-(
 false.
240 %%----------------------------------------
241 %% Borrowed from asn1rt_ber_bin_v2.erl
242 %%----------------------------------------
243
244 %%% The tag-number for universal types
245 -define(N_BOOLEAN, 1).
246 -define(N_INTEGER, 2).
247 -define(N_BIT_STRING, 3).
248 -define(N_OCTET_STRING, 4).
249 -define(N_NULL, 5).
250 -define(N_OBJECT_IDENTIFIER, 6).
251 -define(N_OBJECT_DESCRIPTOR, 7).
252 -define(N_EXTERNAL, 8).
253 -define(N_REAL, 9).
254 -define(N_ENUMERATED, 10).
255 -define(N_EMBEDDED_PDV, 11).
256 -define(N_SEQUENCE, 16).
257 -define(N_SET, 17).
258 -define(N_NumericString, 18).
259 -define(N_PrintableString, 19).
260 -define(N_TeletexString, 20).
261 -define(N_VideotexString, 21).
262 -define(N_IA5String, 22).
263 -define(N_UTCTime, 23).
264 -define(N_GeneralizedTime, 24).
265 -define(N_GraphicString, 25).
266 -define(N_VisibleString, 26).
267 -define(N_GeneralString, 27).
268 -define(N_UniversalString, 28).
269 -define(N_BMPString, 30).
270
271
272 -spec decode_octet_string(_, _, list()) -> binary().
273 decode_octet_string(Buffer, Range, Tags) ->
274 % NewTags = new_tags(HasTag, #tag{class=?UNIVERSAL, number=?N_OCTET_STRING}),
275 
:-(
 decode_restricted_string(Buffer, Range, Tags).
276
277
278 -spec decode_restricted_string(_, _, list()) -> binary().
279 decode_restricted_string(Tlv, Range, TagsIn) ->
280 
:-(
 Val = match_tags(Tlv, TagsIn),
281 
:-(
 Val2 =
282 case Val of
283 PartList = [_H|_T] -> % constructed val
284 
:-(
 collect_parts(PartList);
285 Bin ->
286 
:-(
 Bin
287 end,
288 
:-(
 check_and_convert_restricted_string(Val2, Range).
289
290
291 -spec check_and_convert_restricted_string(iolist(), _) -> binary().
292 check_and_convert_restricted_string(Val, Range) ->
293 
:-(
 {StrLen, NewVal} = if is_binary(Val) ->
294 
:-(
 {size(Val), Val};
295 true ->
296 
:-(
 {length(Val), list_to_binary(Val)}
297 end,
298 
:-(
 case Range of
299 [] -> % No length constraint
300 
:-(
 NewVal;
301 {Lb, Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint
302 
:-(
 NewVal;
303 {{Lb, _Ub}, []} when StrLen >= Lb ->
304 
:-(
 NewVal;
305 {{Lb, _Ub}, _Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min ->
306 
:-(
 NewVal;
307 {{Lb1, Ub1}, {Lb2, Ub2}} when StrLen >= Lb1, StrLen =< Ub1;
308 StrLen =< Ub2, StrLen >= Lb2 ->
309 
:-(
 NewVal;
310 StrLen -> % fixed length constraint
311 
:-(
 NewVal;
312 {_, _} ->
313 
:-(
 exit({error, {asn1, {length, Range, Val}}});
314 _Len when is_integer(_Len) ->
315 
:-(
 exit({error, {asn1, {length, Range, Val}}});
316 _ -> % some strange constraint that we don't support yet
317 
:-(
 NewVal
318 end.
319
320 %%----------------------------------------
321 %% Decode the in buffer to bits
322 %%----------------------------------------
323 match_tags({T, V}, [T]) ->
324 
:-(
 V;
325 match_tags({T, V}, [T|Tt]) ->
326 
:-(
 match_tags(V, Tt);
327 match_tags([{T, V}], [T|Tt]) ->
328 
:-(
 match_tags(V, Tt);
329 match_tags(Vlist = [{T, _V}|_], [T]) ->
330 
:-(
 Vlist;
331 match_tags(Tlv, []) ->
332 
:-(
 Tlv;
333 match_tags({Tag, _V}, [T|_Tt]) ->
334 
:-(
 {error, {asn1, {wrong_tag, {Tag, T}}}}.
335
336
337 -spec collect_parts([{_, _}]) -> binary().
338 collect_parts(TlvList) ->
339 
:-(
 collect_parts(TlvList, []).
340
341
342 -spec collect_parts([{_, _}], [any()]) -> binary().
343 collect_parts([{_, L}|Rest], Acc) when is_list(L) ->
344 
:-(
 collect_parts(Rest, [collect_parts(L)|Acc]);
345 collect_parts([{?N_BIT_STRING, <<Unused, Bits/binary>>}|Rest], _Acc) ->
346 
:-(
 collect_parts_bit(Rest, [Bits], Unused);
347 collect_parts([{_T, V}|Rest], Acc) ->
348 
:-(
 collect_parts(Rest, [V|Acc]);
349 collect_parts([], Acc) ->
350 
:-(
 list_to_binary(lists:reverse(Acc)).
351
352
353 -spec collect_parts_bit([{3, binary()}], [binary(), ...], non_neg_integer()) -> binary().
354 collect_parts_bit([{?N_BIT_STRING, <<Unused, Bits/binary>>}|Rest], Acc, Uacc) ->
355 
:-(
 collect_parts_bit(Rest, [Bits|Acc], Unused+Uacc);
356 collect_parts_bit([], Acc, Uacc) ->
357 
:-(
 maybe_list2b([Uacc|lists:reverse(Acc)]).
358
359 maybe_b2list(B) when is_binary(B) ->
360 
:-(
 binary_to_list(B);
361 maybe_b2list(L) when is_list(L) ->
362 
:-(
 L;
363 maybe_b2list(O) ->
364 
:-(
 {error, {unknown_type, O}}.
365
366 maybe_list2b(L) when is_list(L) ->
367 
:-(
 list_to_binary(L);
368 maybe_list2b(B) when is_binary(B) ->
369 
:-(
 B;
370 maybe_list2b(O) ->
371 
:-(
 {error, {unknown_type, O}}.
Line Hits Source