diff options
Diffstat (limited to 'src/eldap')
| -rw-r--r-- | src/eldap/Makefile.in | 6 | ||||
| -rw-r--r-- | src/eldap/eldap.erl | 1231 | ||||
| -rw-r--r-- | src/eldap/eldap.hrl | 49 | ||||
| -rw-r--r-- | src/eldap/eldap_filter.erl | 55 | ||||
| -rw-r--r-- | src/eldap/eldap_filter_yecc.yrl | 2 | ||||
| -rw-r--r-- | src/eldap/eldap_pool.erl | 72 | ||||
| -rw-r--r-- | src/eldap/eldap_utils.erl | 264 |
7 files changed, 957 insertions, 722 deletions
diff --git a/src/eldap/Makefile.in b/src/eldap/Makefile.in index 8a0a0d768..a44bee595 100644 --- a/src/eldap/Makefile.in +++ b/src/eldap/Makefile.in @@ -6,7 +6,7 @@ CPPFLAGS = @CPPFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ -ASN_FLAGS = -bber_bin +optimize +ASN_FLAGS = -bber_bin +optimize +binary_strings ERLANG_CFLAGS = @ERLANG_CFLAGS@ ERLANG_LIBS = @ERLANG_LIBS@ @@ -17,7 +17,7 @@ EFLAGS += -pz .. # make debug=true to compile Erlang module with debug informations. ifdef debug - EFLAGS+=+debug_info +export_all + EFLAGS+=+debug_info endif OUTDIR = .. @@ -31,6 +31,8 @@ ELDAPv3.beam: ELDAPv3.erl ELDAPv3.erl: ELDAPv3.asn @ERLC@ $(ASN_FLAGS) -W $(EFLAGS) $< + @ERL@ -noinput +B -eval \ + 'case file:read_file("ELDAPv3.erl") of {ok, Data} -> NewData = re:replace(Data, "\\?RT_BER:decode_octet_string", "eldap_utils:decode_octet_string", [global]), file:write_file("ELDAPv3.erl", NewData), halt(0); _Err -> halt(1) end' eldap_filter_yecc.beam: eldap_filter_yecc.erl diff --git a/src/eldap/eldap.erl b/src/eldap/eldap.erl index e18d2e22a..4df7d00eb 100644 --- a/src/eldap/eldap.erl +++ b/src/eldap/eldap.erl @@ -7,6 +7,7 @@ %%% %%% Copyright (C) 2000 Torbjorn Tornkvist, tnt@home.se %%% +%%% %%% This program is free software; you can redistribute it and/or modify %%% it under the terms of the GNU General Public License as published by %%% the Free Software Foundation; either version 2 of the License, or @@ -21,7 +22,6 @@ %%% along with this program; if not, write to the Free Software %%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - %%% Modified by Sean Hinde <shinde@iee.org> 7th Dec 2000 %%% Turned into gen_fsm, made non-blocking, added timers etc to support this. %%% Now has the concept of a name (string() or atom()) per instance which allows @@ -30,7 +30,6 @@ %%% Can be configured with start_link parameters or use a config file to get %%% host to connect to, dn, password, log function etc. - %%% Modified by Alexey Shchepin <alexey@sevcom.net> %%% Modified by Evgeniy Khramtsov <ekhramtsov@process-one.net> @@ -55,7 +54,6 @@ %%% -------------------------------------------------------------------- -vc('$Id$ '). - %%%---------------------------------------------------------------------- %%% LDAP Client state machine. %%% Possible states are: @@ -72,68 +70,95 @@ %% External exports -export([start_link/1, start_link/6]). --export([baseObject/0,singleLevel/0,wholeSubtree/0,close/1, - equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, - 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, modify_passwd/3, bind/3]). +-export([baseObject/0, singleLevel/0, wholeSubtree/0, + close/1, equalityMatch/2, greaterOrEqual/2, + lessOrEqual/2, 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, modify_passwd/3, bind/3]). + -export([get_status/1]). %% gen_fsm callbacks --export([init/1, connecting/2, - connecting/3, wait_bind_response/3, active/3, active_bind/3, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). - +-export([init/1, connecting/2, connecting/3, + wait_bind_response/3, active/3, active_bind/3, + handle_event/3, handle_sync_event/4, handle_info/3, + terminate/3, code_change/4]). --import(lists,[concat/1]). +-export_type([filter/0]). -include("ELDAPv3.hrl"). + -include("eldap.hrl"). -define(LDAP_VERSION, 3). + -define(RETRY_TIMEOUT, 500). + -define(BIND_TIMEOUT, 10000). + -define(CMD_TIMEOUT, 100000). %% Used in gen_fsm sync calls. --define(CALL_TIMEOUT, ?CMD_TIMEOUT + ?BIND_TIMEOUT + ?RETRY_TIMEOUT). %% Used as a timeout for gen_tcp:send/2 + +-define(CALL_TIMEOUT, + (?CMD_TIMEOUT) + (?BIND_TIMEOUT) + (?RETRY_TIMEOUT)). + -define(SEND_TIMEOUT, 30000). + -define(MAX_TRANSACTION_ID, 65535). + -define(MIN_TRANSACTION_ID, 0). %% Grace period after "soft" LDAP bind errors: + -define(GRACEFUL_RETRY_TIMEOUT, 5000). --define(SUPPORTEDEXTENSION, "1.3.6.1.4.1.1466.101.120.7"). --define(SUPPORTEDEXTENSIONSYNTAX, "1.3.6.1.4.1.1466.115.121.1.38"). --define(STARTTLS, "1.3.6.1.4.1.1466.20037"). - --record(eldap, {version = ?LDAP_VERSION, - hosts, % Possible hosts running LDAP servers - host = null, % Connected Host LDAP server - port = 389, % The LDAP server port - sockmod, % SockMod (gen_tcp|tls) - tls = none, % LDAP/LDAPS (none|tls) - tls_options = [], - fd = null, % Socket filedescriptor. - rootdn = "", % Name of the entry to bind as - passwd, % Password for (above) entry - id = 0, % LDAP Request ID - bind_timer, % Ref to bind timeout - dict, % dict holding operation params and results - req_q % Queue for requests - }). +-define(SUPPORTEDEXTENSION, + <<"1.3.6.1.4.1.1466.101.120.7">>). + +-define(SUPPORTEDEXTENSIONSYNTAX, + <<"1.3.6.1.4.1.1466.115.121.1.38">>). + +-define(STARTTLS, <<"1.3.6.1.4.1.1466.20037">>). + +-type handle() :: pid() | atom() | binary(). + +-record(eldap, + {version = ?LDAP_VERSION :: non_neg_integer(), + hosts = [] :: [binary()], + host :: binary(), + port = 389 :: inet:port_number(), + sockmod = gen_tcp :: ssl | gen_tcp, + tls = none :: none | tls, + tls_options = [] :: [{cacertfile, string()} | + {depth, non_neg_integer()} | + {verify, non_neg_integer()}], + fd, + rootdn = <<"">> :: binary(), + passwd = <<"">> :: binary(), + id = 0 :: non_neg_integer(), + bind_timer = make_ref() :: reference(), + dict = dict:new() :: dict(), + req_q = queue:new() :: queue()}). %%%---------------------------------------------------------------------- %%% API %%%---------------------------------------------------------------------- start_link(Name) -> - Reg_name = list_to_atom("eldap_" ++ Name), + Reg_name = jlib:binary_to_atom(<<"eldap_", + Name/binary>>), gen_fsm:start_link({local, Reg_name}, ?MODULE, [], []). +-spec start_link(binary(), [binary()], inet:port_number(), binary(), + binary(), tlsopts()) -> any(). + start_link(Name, Hosts, Port, Rootdn, Passwd, Opts) -> - Reg_name = list_to_atom("eldap_" ++ Name), + Reg_name = jlib:binary_to_atom(<<"eldap_", + Name/binary>>), gen_fsm:start_link({local, Reg_name}, ?MODULE, - {Hosts, Port, Rootdn, Passwd, Opts}, []). + [Hosts, Port, Rootdn, Passwd, Opts], []). + +-spec get_status(handle()) -> any(). %%% -------------------------------------------------------------------- %%% Get status of connection. @@ -145,6 +170,8 @@ get_status(Handle) -> %%% -------------------------------------------------------------------- %%% Shutdown connection (and process) asynchronous. %%% -------------------------------------------------------------------- +-spec close(handle()) -> any(). + close(Handle) -> Handle1 = get_handle(Handle), gen_fsm:send_all_state_event(Handle1, close). @@ -162,23 +189,21 @@ close(Handle) -> %%% {"telephoneNumber", ["545 555 00"]}] %%% ) %%% -------------------------------------------------------------------- -add(Handle, Entry, Attributes) when is_list(Entry), is_list(Attributes) -> +add(Handle, Entry, Attributes) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event(Handle1, {add, Entry, add_attrs(Attributes)}, - ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, + {add, Entry, add_attrs(Attributes)}, ?CALL_TIMEOUT). %%% Do sanity check ! add_attrs(Attrs) -> - F = fun({Type,Vals}) when is_list(Type), is_list(Vals) -> - %% Confused ? Me too... :-/ - {'AddRequest_attributes',Type, Vals} + F = fun ({Type, Vals}) -> + {'AddRequest_attributes', Type, Vals} end, case catch lists:map(F, Attrs) of - {'EXIT', _} -> throw({error, attribute_values}); - Else -> Else + {'EXIT', _} -> throw({error, attribute_values}); + Else -> Else end. - %%% -------------------------------------------------------------------- %%% Delete an entry. The entry consists of the DN of %%% the entry to be deleted. @@ -188,9 +213,10 @@ add_attrs(Attrs) -> %%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com" %%% ) %%% -------------------------------------------------------------------- -delete(Handle, Entry) when is_list(Entry) -> +delete(Handle, Entry) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event(Handle1, {delete, Entry}, ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, {delete, Entry}, + ?CALL_TIMEOUT). %%% -------------------------------------------------------------------- %%% Modify an entry. Given an entry a number of modification @@ -203,25 +229,23 @@ delete(Handle, Entry) when is_list(Entry) -> %%% add("description", ["LDAP hacker"])] %%% ) %%% -------------------------------------------------------------------- -modify(Handle, Object, Mods) when is_list(Object), is_list(Mods) -> +-spec modify(handle(), any(), [add | delete | replace]) -> any(). + +modify(Handle, Object, Mods) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event(Handle1, {modify, Object, Mods}, ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, {modify, Object, Mods}, + ?CALL_TIMEOUT). %%% %%% Modification operations. %%% Example: %%% replace("telephoneNumber", ["555 555 00"]) %%% -mod_add(Type, Values) when is_list(Type), is_list(Values) -> m(add, Type, Values). -mod_delete(Type, Values) when is_list(Type), is_list(Values) -> m(delete, Type, Values). -mod_replace(Type, Values) when is_list(Type), is_list(Values) -> m(replace, Type, Values). +mod_add(Type, Values) -> + m(add, Type, Values). -m(Operation, Type, Values) -> - #'ModifyRequest_modification_SEQOF'{ - operation = Operation, - modification = #'AttributeTypeAndValues'{ - type = Type, - vals = Values}}. +mod_delete(Type, Values) -> + m(delete, Type, Values). %%% -------------------------------------------------------------------- %%% Modify an entry. Given an entry a number of modification @@ -235,18 +259,31 @@ m(Operation, Type, Values) -> %%% "" %%% ) %%% -------------------------------------------------------------------- -modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) - when is_list(Entry), is_list(NewRDN), is_atom(DelOldRDN), is_list(NewSup) -> +mod_replace(Type, Values) -> + m(replace, Type, Values). + +m(Operation, Type, Values) -> + #'ModifyRequest_modification_SEQOF'{operation = + Operation, + modification = + #'AttributeTypeAndValues'{type = + Type, + vals = + Values}}. + +modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event( - Handle1, - {modify_dn, Entry, NewRDN, bool_p(DelOldRDN), optional(NewSup)}, - ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, + {modify_dn, Entry, NewRDN, bool_p(DelOldRDN), + optional(NewSup)}, + ?CALL_TIMEOUT). + +-spec modify_passwd(handle(), binary(), binary()) -> any(). -modify_passwd(Handle, DN, Passwd) when is_list(DN), is_list(Passwd) -> +modify_passwd(Handle, DN, Passwd) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event( - Handle1, {modify_passwd, DN, Passwd}, ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, + {modify_passwd, DN, Passwd}, ?CALL_TIMEOUT). %%% -------------------------------------------------------------------- %%% Bind. @@ -256,16 +293,18 @@ modify_passwd(Handle, DN, Passwd) when is_list(DN), is_list(Passwd) -> %%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", %%% "secret") %%% -------------------------------------------------------------------- -bind(Handle, RootDN, Passwd) - when is_list(RootDN), is_list(Passwd) -> +-spec bind(handle(), binary(), binary()) -> any(). + +bind(Handle, RootDN, Passwd) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event(Handle1, {bind, RootDN, Passwd}, ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, {bind, RootDN, Passwd}, + ?CALL_TIMEOUT). %%% Sanity checks ! -bool_p(Bool) when Bool==true;Bool==false -> Bool. +bool_p(Bool) when Bool == true; Bool == false -> Bool. -optional([]) -> asn1_NOVALUE; +optional([]) -> asn1_NOVALUE; optional(Value) -> Value. %%% -------------------------------------------------------------------- @@ -293,82 +332,149 @@ optional(Value) -> Value. %%% []}} %%% %%% -------------------------------------------------------------------- +-type search_args() :: [{base, binary()} | + {filter, filter()} | + {scope, scope()} | + {attributes, [binary()]} | + {types_only, boolean()} | + {timeout, non_neg_integer()} | + {limit, non_neg_integer()} | + {deref_aliases, never | searching | finding | always}]. + +-spec search(handle(), eldap_search() | search_args()) -> any(). + search(Handle, A) when is_record(A, eldap_search) -> call_search(Handle, A); search(Handle, L) when is_list(L) -> case catch parse_search_args(L) of - {error, Emsg} -> {error, Emsg}; - {'EXIT', Emsg} -> {error, Emsg}; - A when is_record(A, eldap_search) -> call_search(Handle, A) + {error, Emsg} -> {error, Emsg}; + {'EXIT', Emsg} -> {error, Emsg}; + A when is_record(A, eldap_search) -> + call_search(Handle, A) end. call_search(Handle, A) -> Handle1 = get_handle(Handle), - gen_fsm:sync_send_event(Handle1, {search, A}, ?CALL_TIMEOUT). + gen_fsm:sync_send_event(Handle1, {search, A}, + ?CALL_TIMEOUT). + +-spec parse_search_args(search_args()) -> eldap_search(). parse_search_args(Args) -> - parse_search_args(Args, #eldap_search{scope = wholeSubtree}). - -parse_search_args([{base, Base}|T],A) -> - parse_search_args(T,A#eldap_search{base = Base}); -parse_search_args([{filter, Filter}|T],A) -> - parse_search_args(T,A#eldap_search{filter = Filter}); -parse_search_args([{scope, Scope}|T],A) -> - parse_search_args(T,A#eldap_search{scope = Scope}); -parse_search_args([{attributes, Attrs}|T],A) -> - parse_search_args(T,A#eldap_search{attributes = Attrs}); -parse_search_args([{types_only, TypesOnly}|T],A) -> - parse_search_args(T,A#eldap_search{types_only = TypesOnly}); -parse_search_args([{timeout, Timeout}|T],A) when is_integer(Timeout) -> - parse_search_args(T,A#eldap_search{timeout = Timeout}); -parse_search_args([{limit, Limit}|T],A) when is_integer(Limit) -> - parse_search_args(T,A#eldap_search{limit = Limit}); -parse_search_args([{deref_aliases, never}|T],A) -> - parse_search_args(T,A#eldap_search{deref_aliases = neverDerefAliases}); -parse_search_args([{deref_aliases, searching}|T],A) -> - parse_search_args(T,A#eldap_search{deref_aliases = derefInSearching}); -parse_search_args([{deref_aliases, finding}|T],A) -> - parse_search_args(T,A#eldap_search{deref_aliases = derefFindingBaseObj}); -parse_search_args([{deref_aliases, always}|T],A) -> - parse_search_args(T,A#eldap_search{deref_aliases = derefAlways}); -parse_search_args([H|_],_) -> - throw({error,{unknown_arg, H}}); -parse_search_args([],A) -> - A. + parse_search_args(Args, + #eldap_search{scope = wholeSubtree}). + +parse_search_args([{base, Base} | T], A) -> + parse_search_args(T, A#eldap_search{base = Base}); +parse_search_args([{filter, Filter} | T], A) -> + parse_search_args(T, A#eldap_search{filter = Filter}); +parse_search_args([{scope, Scope} | T], A) -> + parse_search_args(T, A#eldap_search{scope = Scope}); +parse_search_args([{attributes, Attrs} | T], A) -> + parse_search_args(T, + A#eldap_search{attributes = Attrs}); +parse_search_args([{types_only, TypesOnly} | T], A) -> + parse_search_args(T, + A#eldap_search{types_only = TypesOnly}); +parse_search_args([{timeout, Timeout} | T], A) + when is_integer(Timeout) -> + parse_search_args(T, A#eldap_search{timeout = Timeout}); +parse_search_args([{limit, Limit} | T], A) + when is_integer(Limit) -> + parse_search_args(T, A#eldap_search{limit = Limit}); +parse_search_args([{deref_aliases, never} | T], A) -> + parse_search_args(T, + A#eldap_search{deref_aliases = neverDerefAliases}); +parse_search_args([{deref_aliases, searching} | T], + A) -> + parse_search_args(T, + A#eldap_search{deref_aliases = derefInSearching}); +parse_search_args([{deref_aliases, finding} | T], A) -> + parse_search_args(T, + A#eldap_search{deref_aliases = derefFindingBaseObj}); +parse_search_args([{deref_aliases, always} | T], A) -> + parse_search_args(T, + A#eldap_search{deref_aliases = derefAlways}); +parse_search_args([H | _], _) -> + throw({error, {unknown_arg, H}}); +parse_search_args([], A) -> A. + +baseObject() -> baseObject. + +singleLevel() -> singleLevel. %%% %%% The Scope parameter %%% -baseObject() -> baseObject. -singleLevel() -> singleLevel. wholeSubtree() -> wholeSubtree. %%% %%% Boolean filter operations %%% -'and'(ListOfFilters) when is_list(ListOfFilters) -> {'and',ListOfFilters}. -'or'(ListOfFilters) when is_list(ListOfFilters) -> {'or', ListOfFilters}. -'not'(Filter) when is_tuple(Filter) -> {'not',Filter}. +-type filter() :: 'and'() | 'or'() | 'not'() | equalityMatch() | + greaterOrEqual() | lessOrEqual() | approxMatch() | + present() | substrings() | extensibleMatch(). %%% %%% The following Filter parameters consist of an attribute %%% and an attribute value. Example: F("uid","tobbe") %%% -equalityMatch(Desc, Value) -> {equalityMatch, av_assert(Desc, Value)}. -greaterOrEqual(Desc, Value) -> {greaterOrEqual, av_assert(Desc, Value)}. -lessOrEqual(Desc, Value) -> {lessOrEqual, av_assert(Desc, Value)}. -approxMatch(Desc, Value) -> {approxMatch, av_assert(Desc, Value)}. +-type 'and'() :: {'and', [filter()]}. +-spec 'and'([filter()]) -> 'and'(). + +'and'(ListOfFilters) when is_list(ListOfFilters) -> + {'and', ListOfFilters}. + +-type 'or'() :: {'or', [filter()]}. +-spec 'or'([filter()]) -> 'or'(). + +'or'(ListOfFilters) when is_list(ListOfFilters) -> + {'or', ListOfFilters}. + +-type 'not'() :: {'not', filter()}. +-spec 'not'(filter()) -> 'not'(). + +'not'(Filter) when is_tuple(Filter) -> {'not', Filter}. + +-type equalityMatch() :: {equalityMatch, 'AttributeValueAssertion'()}. +-spec equalityMatch(binary(), binary()) -> equalityMatch(). + +equalityMatch(Desc, Value) -> + {equalityMatch, av_assert(Desc, Value)}. + +-type greaterOrEqual() :: {greaterOrEqual, 'AttributeValueAssertion'()}. +-spec greaterOrEqual(binary(), binary()) -> greaterOrEqual(). + +greaterOrEqual(Desc, Value) -> + {greaterOrEqual, av_assert(Desc, Value)}. + +-type lessOrEqual() :: {lessOrEqual, 'AttributeValueAssertion'()}. +-spec lessOrEqual(binary(), binary()) -> lessOrEqual(). + +lessOrEqual(Desc, Value) -> + {lessOrEqual, av_assert(Desc, Value)}. + +-type approxMatch() :: {approxMatch, 'AttributeValueAssertion'()}. +-spec approxMatch(binary(), binary()) -> approxMatch(). + +approxMatch(Desc, Value) -> + {approxMatch, av_assert(Desc, Value)}. + +-type 'AttributeValueAssertion'() :: + #'AttributeValueAssertion'{attributeDesc :: binary(), + assertionValue :: binary()}. + +-spec av_assert(binary(), binary()) -> 'AttributeValueAssertion'(). av_assert(Desc, Value) -> - #'AttributeValueAssertion'{attributeDesc = Desc, + #'AttributeValueAssertion'{attributeDesc = Desc, assertionValue = Value}. %%% %%% Filter to check for the presence of an attribute %%% -present(Attribute) when is_list(Attribute) -> - {present, Attribute}. - +-type present() :: {present, binary()}. +-spec present(binary()) -> present(). %%% %%% A substring filter seem to be based on a pattern: @@ -385,10 +491,8 @@ present(Attribute) when is_list(Attribute) -> %%% Example: substrings("sn",[{initial,"To"},{any,"kv"},{final,"st"}]) %%% will match entries containing: 'sn: Tornkvist' %%% -substrings(Type, SubStr) when is_list(Type), is_list(SubStr) -> - Ss = {'SubstringFilter_substrings',v_substr(SubStr)}, - {substrings,#'SubstringFilter'{type = Type, - substrings = Ss}}. +present(Attribute) -> + {present, Attribute}. %%% %%% extensibleMatch filter. @@ -399,24 +503,56 @@ substrings(Type, SubStr) when is_list(Type), is_list(SubStr) -> %%% %%% 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}); +-type substr() :: [{initial | any | final, binary()}]. +-type 'SubstringFilter'() :: + #'SubstringFilter'{type :: binary(), + substrings :: {'SubstringFilter_substrings', + substr()}}. + +-type substrings() :: {substrings, 'SubstringFilter'()}. +-spec substrings(binary(), substr()) -> substrings(). + +substrings(Type, SubStr) -> + Ss = {'SubstringFilter_substrings', SubStr}, + {substrings, + #'SubstringFilter'{type = Type, substrings = Ss}}. + +-type match_opts() :: [{matchingRule | type, binary()} | + {dnAttributes, boolean()}]. + +-type 'MatchingRuleAssertion'() :: + #'MatchingRuleAssertion'{matchValue :: binary(), + type :: asn1_NOVALUE | binary(), + matchingRule :: asn1_NOVALUE | binary(), + dnAttributes :: asn1_DEFAULT | true}. + +-type extensibleMatch() :: {extensibleMatch, 'MatchingRuleAssertion'()}. +-spec extensibleMatch(binary(), match_opts()) -> extensibleMatch(). + +extensibleMatch(Value, Opts) -> + MRA = #'MatchingRuleAssertion'{matchValue = Value}, + {extensibleMatch, extensibleMatch_opts(Opts, MRA)}. + +extensibleMatch_opts([{matchingRule, Rule} | Opts], MRA) -> + extensibleMatch_opts(Opts, + MRA#'MatchingRuleAssertion'{matchingRule = Rule}); +extensibleMatch_opts([{type, Desc} | Opts], MRA) -> + 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. + extensibleMatch_opts(Opts, MRA); +extensibleMatch_opts([], MRA) -> MRA. -get_handle(Pid) when is_pid(Pid) -> Pid; +get_handle(Pid) when is_pid(Pid) -> Pid; get_handle(Atom) when is_atom(Atom) -> Atom; -get_handle(Name) when is_list(Name) -> list_to_atom("eldap_" ++ Name). +get_handle(Name) when is_binary(Name) -> + jlib:binary_to_atom(<<"eldap_", + Name/binary>>). + %%%---------------------------------------------------------------------- %%% Callback functions from gen_fsm %%%---------------------------------------------------------------------- @@ -430,63 +566,71 @@ get_handle(Name) when is_list(Name) -> list_to_atom("eldap_" ++ Name). %% I use the trick of setting a timeout of 0 to pass control into the %% process. %%---------------------------------------------------------------------- -init([]) -> - case get_config() of - {ok, Hosts, Port, Rootdn, Passwd, Opts} -> - init({Hosts, Port, Rootdn, Passwd, Opts}); - {error, Reason} -> - {stop, Reason} - end; -init({Hosts, Port, Rootdn, Passwd, Opts}) -> +init([Hosts, Port, Rootdn, Passwd, Opts]) -> catch ssl:start(), - %% ssl:seed was removed in OTP R14B04, newer Dialyzer will complain - catch ssl:seed(randoms:get_string()), - Encrypt = case proplists:get_value(encrypt, Opts) of - tls -> tls; - _ -> none + Encrypt = case gen_mod:get_opt(encrypt, Opts, + fun(tls) -> tls; + (starttls) -> starttls; + (none) -> none + end) of + tls -> tls; + _ -> none end, PortTemp = case Port of - undefined -> - case Encrypt of - tls -> - ?LDAPS_PORT; - _ -> - ?LDAP_PORT - end; - PT -> PT + undefined -> + case Encrypt of + tls -> ?LDAPS_PORT; + _ -> ?LDAP_PORT + end; + PT -> PT end, - CacertOpts = case proplists:get_value(tls_cacertfile, Opts) of - [_|_] = Path -> [{cacertfile, Path}]; - _ -> [] + CacertOpts = case gen_mod:get_opt( + tls_cacertfile, Opts, + fun(S) when is_binary(S) -> + binary_to_list(S); + (undefined) -> + undefined + end) of + undefined -> + []; + Path -> + [{cacertfile, Path}] end, - DepthOpts = case proplists:get_value(tls_depth, Opts) of - Depth when is_integer(Depth), Depth >= 0 -> - [{depth, Depth}]; - _ -> [] + DepthOpts = case gen_mod:get_opt( + tls_depth, Opts, + fun(I) when is_integer(I), I>=0 -> + I; + (undefined) -> + undefined + end) of + undefined -> + []; + Depth -> + [{depth, Depth}] end, - Verify = proplists:get_value(tls_verify, Opts), + Verify = gen_mod:get_opt(tls_verify, Opts, + fun(hard) -> hard; + (soft) -> soft; + (false) -> false + end, false), TLSOpts = if (Verify == hard orelse Verify == soft) - andalso CacertOpts == [] -> - ?WARNING_MSG("TLS verification is enabled " - "but no CA certfiles configured, so " - "verification is disabled.", []), - []; - Verify == soft -> - [{verify, 1}] ++ CacertOpts ++ DepthOpts; - Verify == hard -> - [{verify, 2}] ++ CacertOpts ++ DepthOpts; - true -> - [] - end, - {ok, connecting, #eldap{hosts = Hosts, - port = PortTemp, - rootdn = Rootdn, - passwd = Passwd, - tls = Encrypt, - tls_options = TLSOpts, - id = 0, - dict = dict:new(), - req_q = queue:new()}, 0}. + andalso CacertOpts == [] -> + ?WARNING_MSG("TLS verification is enabled but no CA " + "certfiles configured, so verification " + "is disabled.", + []), + []; + Verify == soft -> + [{verify, 1}] ++ CacertOpts ++ DepthOpts; + Verify == hard -> + [{verify, 2}] ++ CacertOpts ++ DepthOpts; + true -> [] + end, + {ok, connecting, + #eldap{hosts = Hosts, port = PortTemp, rootdn = Rootdn, + passwd = Passwd, tls = Encrypt, tls_options = TLSOpts, + id = 0, dict = dict:new(), req_q = queue:new()}, + 0}. %%---------------------------------------------------------------------- %% Func: StateName/2 @@ -511,15 +655,15 @@ connecting(timeout, S) -> %%---------------------------------------------------------------------- connecting(Event, From, S) -> Q = queue:in({Event, From}, S#eldap.req_q), - {next_state, connecting, S#eldap{req_q=Q}}. + {next_state, connecting, S#eldap{req_q = Q}}. wait_bind_response(Event, From, S) -> Q = queue:in({Event, From}, S#eldap.req_q), - {next_state, wait_bind_response, S#eldap{req_q=Q}}. + {next_state, wait_bind_response, S#eldap{req_q = Q}}. active_bind(Event, From, S) -> Q = queue:in({Event, From}, S#eldap.req_q), - {next_state, active_bind, S#eldap{req_q=Q}}. + {next_state, active_bind, S#eldap{req_q = Q}}. active(Event, From, S) -> process_command(S, Event, From). @@ -534,7 +678,6 @@ active(Event, From, S) -> handle_event(close, _StateName, S) -> catch (S#eldap.sockmod):close(S#eldap.fd), {stop, normal, S}; - handle_event(_Event, StateName, S) -> {next_state, StateName, S}. @@ -556,6 +699,7 @@ handle_sync_event(_Event, _From, StateName, S) -> %% Returns: {next_state, NextStateName, NextStateData} | %% {next_state, NextStateName, NextStateData, Timeout} | %% {stop, Reason, NewStateData} +%% {stop, Reason, NewStateData} %%---------------------------------------------------------------------- %% @@ -563,83 +707,78 @@ handle_sync_event(_Event, _From, StateName, S) -> %% handle_info({Tag, _Socket, Data}, connecting, S) when Tag == tcp; Tag == ssl -> - ?DEBUG("tcp packet received when disconnected!~n~p", [Data]), + ?DEBUG("tcp packet received when disconnected!~n~p", + [Data]), {next_state, connecting, S}; - handle_info({Tag, _Socket, Data}, wait_bind_response, S) when Tag == tcp; Tag == ssl -> cancel_timer(S#eldap.bind_timer), case catch recvd_wait_bind_response(Data, S) of - bound -> - dequeue_commands(S); - {fail_bind, Reason} -> - report_bind_failure(S#eldap.host, S#eldap.port, Reason), - {next_state, connecting, close_and_retry(S, ?GRACEFUL_RETRY_TIMEOUT)}; - {'EXIT', Reason} -> - report_bind_failure(S#eldap.host, S#eldap.port, Reason), - {next_state, connecting, close_and_retry(S)}; - {error, Reason} -> - report_bind_failure(S#eldap.host, S#eldap.port, Reason), - {next_state, connecting, close_and_retry(S)} + bound -> dequeue_commands(S); + {fail_bind, Reason} -> + report_bind_failure(S#eldap.host, S#eldap.port, Reason), + {next_state, connecting, + close_and_retry(S, ?GRACEFUL_RETRY_TIMEOUT)}; + {'EXIT', Reason} -> + report_bind_failure(S#eldap.host, S#eldap.port, Reason), + {next_state, connecting, close_and_retry(S)}; + {error, Reason} -> + report_bind_failure(S#eldap.host, S#eldap.port, Reason), + {next_state, connecting, close_and_retry(S)} end; - handle_info({Tag, _Socket, Data}, StateName, S) - when (StateName == active orelse StateName == active_bind) andalso - (Tag == tcp orelse Tag == ssl) -> + when (StateName == active orelse + StateName == active_bind) + andalso (Tag == tcp orelse Tag == ssl) -> case catch recvd_packet(Data, S) of - {response, Response, RequestType} -> - NewS = case Response of - {reply, Reply, To, S1} -> - gen_fsm:reply(To, Reply), - S1; - {ok, S1} -> - S1 - end, - if (StateName == active_bind andalso - RequestType == bindRequest) orelse - (StateName == active) -> - dequeue_commands(NewS); - true -> - {next_state, StateName, NewS} - end; - _ -> - {next_state, StateName, S} + {response, Response, RequestType} -> + NewS = case Response of + {reply, Reply, To, S1} -> gen_fsm:reply(To, Reply), S1; + {ok, S1} -> S1 + end, + if StateName == active_bind andalso + RequestType == bindRequest + orelse StateName == active -> + dequeue_commands(NewS); + true -> {next_state, StateName, NewS} + end; + _ -> {next_state, StateName, S} end; - handle_info({Tag, _Socket}, Fsm_state, S) when Tag == tcp_closed; Tag == ssl_closed -> - ?WARNING_MSG("LDAP server closed the connection: ~s:~p~nIn State: ~p", - [S#eldap.host, S#eldap.port ,Fsm_state]), + ?WARNING_MSG("LDAP server closed the connection: ~s:~p~nIn " + "State: ~p", + [S#eldap.host, S#eldap.port, Fsm_state]), {next_state, connecting, close_and_retry(S)}; - handle_info({Tag, _Socket, Reason}, Fsm_state, S) when Tag == tcp_error; Tag == ssl_error -> - ?DEBUG("eldap received tcp_error: ~p~nIn State: ~p", [Reason, Fsm_state]), + ?DEBUG("eldap received tcp_error: ~p~nIn State: ~p", + [Reason, Fsm_state]), {next_state, connecting, close_and_retry(S)}; - %% %% Timers %% -handle_info({timeout, Timer, {cmd_timeout, Id}}, StateName, S) -> +handle_info({timeout, Timer, {cmd_timeout, Id}}, + StateName, S) -> case cmd_timeout(Timer, Id, S) of - {reply, To, Reason, NewS} -> gen_fsm:reply(To, Reason), - {next_state, StateName, NewS}; - {error, _Reason} -> {next_state, StateName, S} + {reply, To, Reason, NewS} -> + gen_fsm:reply(To, Reason), + {next_state, StateName, NewS}; + {error, _Reason} -> {next_state, StateName, S} end; - handle_info({timeout, retry_connect}, connecting, S) -> - {ok, NextState, NewS} = connect_bind(S), + {ok, NextState, NewS} = connect_bind(S), {next_state, NextState, NewS}; - -handle_info({timeout, _Timer, bind_timeout}, wait_bind_response, S) -> +handle_info({timeout, _Timer, bind_timeout}, + wait_bind_response, S) -> {next_state, connecting, close_and_retry(S)}; - %% %% Make sure we don't fill the message queue with rubbish %% handle_info(Info, StateName, S) -> - ?DEBUG("eldap. Unexpected Info: ~p~nIn state: ~p~n when StateData is: ~p", - [Info, StateName, S]), + ?DEBUG("eldap. Unexpected Info: ~p~nIn state: " + "~p~n when StateData is: ~p", + [Info, StateName, S]), {next_state, StateName, S}. %%---------------------------------------------------------------------- @@ -647,8 +786,7 @@ handle_info(Info, StateName, S) -> %% Purpose: Shutdown the fsm %% Returns: any %%---------------------------------------------------------------------- -terminate(_Reason, _StateName, _StatData) -> - ok. +terminate(_Reason, _StateName, _StatData) -> ok. %%---------------------------------------------------------------------- %% Func: code_change/4 @@ -663,91 +801,79 @@ code_change(_OldVsn, StateName, S, _Extra) -> %%%---------------------------------------------------------------------- dequeue_commands(S) -> case queue:out(S#eldap.req_q) of - {{value, {Event, From}}, Q} -> - case process_command(S#eldap{req_q=Q}, Event, From) of - {_, active, NewS} -> - dequeue_commands(NewS); - Res -> - Res - end; - {empty, _} -> - {next_state, active, S} + {{value, {Event, From}}, Q} -> + case process_command(S#eldap{req_q = Q}, Event, From) of + {_, active, NewS} -> dequeue_commands(NewS); + Res -> Res + end; + {empty, _} -> {next_state, active, S} end. process_command(S, Event, From) -> case send_command(Event, From, S) of - {ok, NewS} -> - case Event of - {bind, _, _} -> - {next_state, active_bind, NewS}; - _ -> - {next_state, active, NewS} - end; - {error, _Reason} -> - Q = queue:in_r({Event, From}, S#eldap.req_q), - NewS = close_and_retry(S#eldap{req_q=Q}), - {next_state, connecting, NewS} + {ok, NewS} -> + case Event of + {bind, _, _} -> {next_state, active_bind, NewS}; + _ -> {next_state, active, NewS} + end; + {error, _Reason} -> + Q = queue:in_r({Event, From}, S#eldap.req_q), + NewS = close_and_retry(S#eldap{req_q = Q}), + {next_state, connecting, NewS} end. send_command(Command, From, S) -> Id = bump_id(S), {Name, Request} = gen_req(Command), - Message = #'LDAPMessage'{messageID = Id, + Message = #'LDAPMessage'{messageID = Id, protocolOp = {Name, Request}}, - ?DEBUG("~p~n",[{Name, Request}]), - {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message), + ?DEBUG("~p~n", [{Name, Request}]), + {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', + Message), case (S#eldap.sockmod):send(S#eldap.fd, Bytes) of - ok -> - Timer = erlang:start_timer(?CMD_TIMEOUT, self(), {cmd_timeout, Id}), - New_dict = dict:store(Id, [{Timer, Command, From, Name}], S#eldap.dict), - {ok, S#eldap{id = Id, dict = New_dict}}; - Error -> - Error + ok -> + Timer = erlang:start_timer(?CMD_TIMEOUT, self(), + {cmd_timeout, Id}), + New_dict = dict:store(Id, + [{Timer, Command, From, Name}], S#eldap.dict), + {ok, S#eldap{id = Id, dict = New_dict}}; + Error -> Error end. gen_req({search, A}) -> {searchRequest, - #'SearchRequest'{baseObject = A#eldap_search.base, - scope = v_scope(A#eldap_search.scope), + #'SearchRequest'{baseObject = A#eldap_search.base, + scope = A#eldap_search.scope, derefAliases = A#eldap_search.deref_aliases, - sizeLimit = A#eldap_search.limit, - timeLimit = v_timeout(A#eldap_search.timeout), - typesOnly = v_bool(A#eldap_search.types_only), - filter = v_filter(A#eldap_search.filter), - attributes = v_attributes(A#eldap_search.attributes) - }}; + sizeLimit = A#eldap_search.limit, + timeLimit = A#eldap_search.timeout, + typesOnly = A#eldap_search.types_only, + filter = A#eldap_search.filter, + attributes = A#eldap_search.attributes}}; gen_req({add, Entry, Attrs}) -> {addRequest, - #'AddRequest'{entry = Entry, - attributes = Attrs}}; -gen_req({delete, Entry}) -> - {delRequest, Entry}; + #'AddRequest'{entry = Entry, attributes = Attrs}}; +gen_req({delete, Entry}) -> {delRequest, Entry}; gen_req({modify, Obj, Mod}) -> - v_modifications(Mod), - {modifyRequest, - #'ModifyRequest'{object = Obj, - modification = Mod}}; -gen_req({modify_dn, Entry, NewRDN, DelOldRDN, NewSup}) -> + {modifyRequest, + #'ModifyRequest'{object = Obj, modification = Mod}}; +gen_req({modify_dn, Entry, NewRDN, DelOldRDN, + NewSup}) -> {modDNRequest, - #'ModifyDNRequest'{entry = Entry, - newrdn = NewRDN, - deleteoldrdn = DelOldRDN, - newSuperior = NewSup}}; - + #'ModifyDNRequest'{entry = Entry, newrdn = NewRDN, + deleteoldrdn = DelOldRDN, newSuperior = NewSup}}; gen_req({modify_passwd, DN, Passwd}) -> - {ok, ReqVal} = asn1rt:encode( - 'ELDAPv3', 'PasswdModifyRequestValue', - #'PasswdModifyRequestValue'{ - userIdentity = DN, - newPasswd = Passwd}), + {ok, ReqVal} = asn1rt:encode('ELDAPv3', + 'PasswdModifyRequestValue', + #'PasswdModifyRequestValue'{userIdentity = DN, + newPasswd = + Passwd}), {extendedReq, #'ExtendedRequest'{requestName = ?passwdModifyOID, - requestValue = list_to_binary(ReqVal)}}; - + requestValue = iolist_to_binary(ReqVal)}}; gen_req({bind, RootDN, Passwd}) -> {bindRequest, - #'BindRequest'{version = ?LDAP_VERSION, - name = RootDN, + #'BindRequest'{version = ?LDAP_VERSION, name = RootDN, authentication = {simple, Passwd}}}. %%----------------------------------------------------------------------- @@ -762,105 +888,111 @@ gen_req({bind, RootDN, Passwd}) -> %%----------------------------------------------------------------------- recvd_packet(Pkt, S) -> case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of - {ok,Msg} -> - Op = Msg#'LDAPMessage'.protocolOp, - ?DEBUG("~p",[Op]), - Dict = S#eldap.dict, - Id = Msg#'LDAPMessage'.messageID, - {Timer, From, Name, Result_so_far} = get_op_rec(Id, Dict), - Answer = - case {Name, Op} of - {searchRequest, {searchResEntry, R}} when - is_record(R,'SearchResultEntry') -> - New_dict = dict:append(Id, R, Dict), - {ok, S#eldap{dict = New_dict}}; - {searchRequest, {searchResDone, Result}} -> - Reason = Result#'LDAPResult'.resultCode, - if - Reason==success; Reason=='sizeLimitExceeded' -> - {Res, Ref} = polish(Result_so_far), - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - {reply, #eldap_search_result{entries = Res, - referrals = Ref}, From, - S#eldap{dict = New_dict}}; - true -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - {reply, {error, Reason}, From, S#eldap{dict = New_dict}} - end; - {searchRequest, {searchResRef, R}} -> - New_dict = dict:append(Id, R, Dict), - {ok, S#eldap{dict = New_dict}}; - {addRequest, {addResponse, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {delRequest, {delResponse, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {modifyRequest, {modifyResponse, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {modDNRequest, {modDNResponse, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {bindRequest, {bindResponse, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_bind_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {extendedReq, {extendedResp, Result}} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - Reply = check_extended_reply(Result, From), - {reply, Reply, From, S#eldap{dict = New_dict}}; - {OtherName, OtherResult} -> - New_dict = dict:erase(Id, Dict), - cancel_timer(Timer), - {reply, {error, {invalid_result, OtherName, OtherResult}}, - From, S#eldap{dict = New_dict}} - end, - {response, Answer, Name}; - Error -> Error + {ok, Msg} -> + Op = Msg#'LDAPMessage'.protocolOp, + ?DEBUG("~p", [Op]), + Dict = S#eldap.dict, + Id = Msg#'LDAPMessage'.messageID, + {Timer, From, Name, Result_so_far} = get_op_rec(Id, + Dict), + Answer = case {Name, Op} of + {searchRequest, {searchResEntry, R}} + when is_record(R, 'SearchResultEntry') -> + New_dict = dict:append(Id, R, Dict), + {ok, S#eldap{dict = New_dict}}; + {searchRequest, {searchResDone, Result}} -> + Reason = Result#'LDAPResult'.resultCode, + if Reason == success; Reason == sizeLimitExceeded -> + {Res, Ref} = polish(Result_so_far), + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, + #eldap_search_result{entries = Res, + referrals = Ref}, + From, S#eldap{dict = New_dict}}; + true -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, {error, Reason}, From, + S#eldap{dict = New_dict}} + end; + {searchRequest, {searchResRef, R}} -> + New_dict = dict:append(Id, R, Dict), + {ok, S#eldap{dict = New_dict}}; + {addRequest, {addResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {delRequest, {delResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {modifyRequest, {modifyResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {modDNRequest, {modDNResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {bindRequest, {bindResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_bind_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {extendedReq, {extendedResp, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_extended_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {OtherName, OtherResult} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, + {error, {invalid_result, OtherName, OtherResult}}, + From, S#eldap{dict = New_dict}} + end, + {response, Answer, Name}; + Error -> Error end. -check_reply(#'LDAPResult'{resultCode = success}, _From) -> +check_reply(#'LDAPResult'{resultCode = success}, + _From) -> ok; -check_reply(#'LDAPResult'{resultCode = Reason}, _From) -> +check_reply(#'LDAPResult'{resultCode = Reason}, + _From) -> {error, Reason}; -check_reply(Other, _From) -> - {error, Other}. +check_reply(Other, _From) -> {error, Other}. -check_bind_reply(#'BindResponse'{resultCode = success}, _From) -> +check_bind_reply(#'BindResponse'{resultCode = success}, + _From) -> ok; -check_bind_reply(#'BindResponse'{resultCode = Reason}, _From) -> +check_bind_reply(#'BindResponse'{resultCode = Reason}, + _From) -> {error, Reason}; -check_bind_reply(Other, _From) -> - {error, Other}. +check_bind_reply(Other, _From) -> {error, Other}. %% TODO: process reply depending on requestName: %% this requires BER-decoding of #'ExtendedResponse'.response -check_extended_reply(#'ExtendedResponse'{resultCode = success}, _From) -> +check_extended_reply(#'ExtendedResponse'{resultCode = + success}, + _From) -> ok; -check_extended_reply(#'ExtendedResponse'{resultCode = Reason}, _From) -> +check_extended_reply(#'ExtendedResponse'{resultCode = + Reason}, + _From) -> {error, Reason}; -check_extended_reply(Other, _From) -> - {error, Other}. +check_extended_reply(Other, _From) -> {error, Other}. get_op_rec(Id, Dict) -> case dict:find(Id, Dict) of - {ok, [{Timer, _Command, From, Name}|Res]} -> - {Timer, From, Name, Res}; - error -> - throw({error, unkown_id}) + {ok, [{Timer, _Command, From, Name} | Res]} -> + {Timer, From, Name, Res}; + error -> throw({error, unkown_id}) end. %%----------------------------------------------------------------------- @@ -874,22 +1006,21 @@ get_op_rec(Id, Dict) -> %%----------------------------------------------------------------------- recvd_wait_bind_response(Pkt, S) -> case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of - {ok,Msg} -> - ?DEBUG("~p", [Msg]), - check_id(S#eldap.id, Msg#'LDAPMessage'.messageID), - case Msg#'LDAPMessage'.protocolOp of - {bindResponse, Result} -> - case Result#'BindResponse'.resultCode of - success -> bound; - Error -> {fail_bind, Error} - end - end; - Else -> - {fail_bind, Else} + {ok, Msg} -> + ?DEBUG("~p", [Msg]), + check_id(S#eldap.id, Msg#'LDAPMessage'.messageID), + case Msg#'LDAPMessage'.protocolOp of + {bindResponse, Result} -> + case Result#'BindResponse'.resultCode of + success -> bound; + Error -> {fail_bind, Error} + end + end; + Else -> {fail_bind, Else} end. check_id(Id, Id) -> ok; -check_id(_, _) -> throw({error, wrong_bind_id}). +check_id(_, _) -> throw({error, wrong_bind_id}). %%----------------------------------------------------------------------- %% General Helpers @@ -897,32 +1028,28 @@ check_id(_, _) -> throw({error, wrong_bind_id}). cancel_timer(Timer) -> erlang:cancel_timer(Timer), - receive - {timeout, Timer, _} -> - ok - after 0 -> - ok - end. + receive {timeout, Timer, _} -> ok after 0 -> ok end. close_and_retry(S, Timeout) -> catch (S#eldap.sockmod):close(S#eldap.fd), - Queue = dict:fold( - fun(_Id, [{Timer, Command, From, _Name}|_], Q) -> - cancel_timer(Timer), - queue:in_r({Command, From}, Q); - (_, _, Q) -> - Q - end, S#eldap.req_q, S#eldap.dict), - erlang:send_after(Timeout, self(), {timeout, retry_connect}), - S#eldap{fd=null, req_q=Queue, dict=dict:new()}. + Queue = dict:fold(fun (_Id, + [{Timer, Command, From, _Name} | _], Q) -> + cancel_timer(Timer), + queue:in_r({Command, From}, Q); + (_, _, Q) -> Q + end, + S#eldap.req_q, S#eldap.dict), + erlang:send_after(Timeout, self(), + {timeout, retry_connect}), + S#eldap{fd = undefined, req_q = Queue, dict = dict:new()}. close_and_retry(S) -> close_and_retry(S, ?RETRY_TIMEOUT). report_bind_failure(Host, Port, Reason) -> ?WARNING_MSG("LDAP bind failed on ~s:~p~nReason: ~p", - [Host, Port, Reason]). + [Host, Port, Reason]). %%----------------------------------------------------------------------- %% Sort out timed out commands @@ -930,21 +1057,21 @@ report_bind_failure(Host, Port, Reason) -> cmd_timeout(Timer, Id, S) -> Dict = S#eldap.dict, case dict:find(Id, Dict) of - {ok, [{Timer, _Command, From, Name}|Res]} -> - case Name of - searchRequest -> - {Res1, Ref1} = polish(Res), - New_dict = dict:erase(Id, Dict), - {reply, From, {timeout, - #eldap_search_result{entries = Res1, - referrals = Ref1}}, - S#eldap{dict = New_dict}}; - _ -> - New_dict = dict:erase(Id, Dict), - {reply, From, {error, timeout}, S#eldap{dict = New_dict}} - end; - error -> - {error, timed_out_cmd_not_in_dict} + {ok, [{Timer, _Command, From, Name} | Res]} -> + case Name of + searchRequest -> + {Res1, Ref1} = polish(Res), + New_dict = dict:erase(Id, Dict), + {reply, From, + {timeout, + #eldap_search_result{entries = Res1, referrals = Ref1}}, + S#eldap{dict = New_dict}}; + _ -> + New_dict = dict:erase(Id, Dict), + {reply, From, {error, timeout}, + S#eldap{dict = New_dict}} + end; + error -> {error, timed_out_cmd_not_in_dict} end. %%----------------------------------------------------------------------- @@ -954,191 +1081,97 @@ cmd_timeout(Timer, Id, S) -> %%% Polish the returned search result %%% -polish(Entries) -> - polish(Entries, [], []). +polish(Entries) -> polish(Entries, [], []). -polish([H|T], Res, Ref) when is_record(H, 'SearchResultEntry') -> +polish([H | T], Res, Ref) + when is_record(H, 'SearchResultEntry') -> ObjectName = H#'SearchResultEntry'.objectName, - F = fun({_,A,V}) -> {A,V} end, + F = fun ({_, A, V}) -> {A, V} end, Attrs = lists:map(F, H#'SearchResultEntry'.attributes), - polish(T, [#eldap_entry{object_name = ObjectName, - attributes = Attrs}|Res], Ref); -polish([H|T], Res, Ref) -> % No special treatment of referrals at the moment. - polish(T, Res, [H|Ref]); -polish([], Res, Ref) -> - {Res, Ref}. + polish(T, + [#eldap_entry{object_name = ObjectName, + attributes = Attrs} + | Res], + Ref); +polish([H | T], Res, + Ref) -> % No special treatment of referrals at the moment. + polish(T, Res, [H | Ref]); +polish([], Res, Ref) -> {Res, Ref}. %%----------------------------------------------------------------------- %% Connect to next server in list and attempt to bind to it. %%----------------------------------------------------------------------- connect_bind(S) -> Host = next_host(S#eldap.host, S#eldap.hosts), - ?INFO_MSG("LDAP connection on ~s:~p", [Host, S#eldap.port]), + ?INFO_MSG("LDAP connection on ~s:~p", + [Host, S#eldap.port]), Opts = if S#eldap.tls == tls -> - [{packet, asn1}, {active, true}, {keepalive, true}, - binary | S#eldap.tls_options]; - true -> - [{packet, asn1}, {active, true}, {keepalive, true}, - {send_timeout, ?SEND_TIMEOUT}, binary] - end, + [{packet, asn1}, {active, true}, {keepalive, true}, + binary + | S#eldap.tls_options]; + true -> + [{packet, asn1}, {active, true}, {keepalive, true}, + {send_timeout, ?SEND_TIMEOUT}, binary] + end, + HostS = binary_to_list(Host), SocketData = case S#eldap.tls of - tls -> - SockMod = ssl, - ssl:connect(Host, S#eldap.port, Opts); - %% starttls -> %% TODO: Implement STARTTLS; - _ -> - SockMod = gen_tcp, - gen_tcp:connect(Host, S#eldap.port, Opts) + tls -> + SockMod = ssl, ssl:connect(HostS, S#eldap.port, Opts); + %% starttls -> %% TODO: Implement STARTTLS; + _ -> + SockMod = gen_tcp, + gen_tcp:connect(HostS, S#eldap.port, Opts) end, case SocketData of - {ok, Socket} -> - case bind_request(Socket, S#eldap{sockmod = SockMod}) of - {ok, NewS} -> - Timer = erlang:start_timer(?BIND_TIMEOUT, self(), - {timeout, bind_timeout}), - {ok, wait_bind_response, NewS#eldap{fd = Socket, - sockmod = SockMod, - host = Host, - bind_timer = Timer}}; - {error, Reason} -> - report_bind_failure(Host, S#eldap.port, Reason), - NewS = close_and_retry(S), - {ok, connecting, NewS#eldap{host = Host}} - end; - {error, Reason} -> - ?ERROR_MSG("LDAP connection failed:~n" - "** Server: ~s:~p~n" - "** Reason: ~p~n" - "** Socket options: ~p", - [Host, S#eldap.port, Reason, Opts]), - NewS = close_and_retry(S), - {ok, connecting, NewS#eldap{host = Host}} + {ok, Socket} -> + case bind_request(Socket, S#eldap{sockmod = SockMod}) of + {ok, NewS} -> + Timer = erlang:start_timer(?BIND_TIMEOUT, self(), + {timeout, bind_timeout}), + {ok, wait_bind_response, + NewS#eldap{fd = Socket, sockmod = SockMod, host = Host, + bind_timer = Timer}}; + {error, Reason} -> + report_bind_failure(Host, S#eldap.port, Reason), + NewS = close_and_retry(S), + {ok, connecting, NewS#eldap{host = Host}} + end; + {error, Reason} -> + ?ERROR_MSG("LDAP connection failed:~n** Server: " + "~s:~p~n** Reason: ~p~n** Socket options: ~p", + [Host, S#eldap.port, Reason, Opts]), + NewS = close_and_retry(S), + {ok, connecting, NewS#eldap{host = Host}} end. bind_request(Socket, S) -> Id = bump_id(S), - Req = #'BindRequest'{version = S#eldap.version, - name = S#eldap.rootdn, + Req = #'BindRequest'{version = S#eldap.version, + name = S#eldap.rootdn, authentication = {simple, S#eldap.passwd}}, - Message = #'LDAPMessage'{messageID = Id, + Message = #'LDAPMessage'{messageID = Id, protocolOp = {bindRequest, Req}}, - ?DEBUG("Bind Request Message:~p~n",[Message]), - {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message), + ?DEBUG("Bind Request Message:~p~n", [Message]), + {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', + Message), case (S#eldap.sockmod):send(Socket, Bytes) of - ok -> {ok, S#eldap{id = Id}}; - Error -> Error + ok -> {ok, S#eldap{id = Id}}; + Error -> Error end. %% Given last tried Server, find next one to try -next_host(null, [H|_]) -> H; % First time, take first -next_host(Host, Hosts) -> % Find next in turn +next_host(undefined, [H | _]) -> + H; % First time, take first +next_host(Host, + Hosts) -> % Find next in turn next_host(Host, Hosts, Hosts). -next_host(Host, [Host], Hosts) -> hd(Hosts); % Wrap back to first -next_host(Host, [Host|Tail], _Hosts) -> hd(Tail); % Take next -next_host(_Host, [], Hosts) -> hd(Hosts); % Never connected before? (shouldn't happen) -next_host(Host, [_|T], Hosts) -> next_host(Host, T, Hosts). - - %%% -------------------------------------------------------------------- %%% Verify the input data %%% -------------------------------------------------------------------- - -v_filter({'and',L}) -> {'and',L}; -v_filter({'or', L}) -> {'or',L}; -v_filter({'not',L}) -> {'not',L}; -v_filter({equalityMatch,AV}) -> {equalityMatch,AV}; -v_filter({greaterOrEqual,AV}) -> {greaterOrEqual,AV}; -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) -> - F = fun({_,Op,_}) -> - case lists:member(Op,[add,delete,replace]) of - true -> true; - _ -> throw({error,{mod_operation,Op}}) - end - end, - lists:foreach(F, Mods). - -v_substr([{Key,Str}|T]) when is_list(Str),Key==initial;Key==any;Key==final -> - [{Key,Str}|v_substr(T)]; -v_substr([H|_]) -> - throw({error,{substring_arg,H}}); -v_substr([]) -> - []. -v_scope(baseObject) -> baseObject; -v_scope(singleLevel) -> singleLevel; -v_scope(wholeSubtree) -> wholeSubtree; -v_scope(_Scope) -> throw({error,concat(["unknown scope: ",_Scope])}). - -v_bool(true) -> true; -v_bool(false) -> false; -v_bool(_Bool) -> throw({error,concat(["not Boolean: ",_Bool])}). - -v_timeout(I) when is_integer(I), I>=0 -> I; -v_timeout(_I) -> throw({error,concat(["timeout not positive integer: ",_I])}). - -v_attributes(Attrs) -> - F = fun(A) when is_list(A) -> A; - (A) -> throw({error,concat(["attribute not String: ",A])}) - end, - lists:map(F,Attrs). - - %%% -------------------------------------------------------------------- %%% Get and Validate the initial configuration %%% -------------------------------------------------------------------- -get_config() -> - Priv_dir = code:priv_dir(eldap), - File = filename:join(Priv_dir, "eldap.conf"), - case file:consult(File) of - {ok, Entries} -> - case catch parse(Entries) of - {ok, Hosts, Port, Rootdn, Passwd, Opts} -> - {ok, Hosts, Port, Rootdn, Passwd, Opts}; - {error, Reason} -> - {error, Reason}; - {'EXIT', Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -parse(Entries) -> - {ok, - get_hosts(host, Entries), - get_integer(port, Entries), - get_list(rootdn, Entries), - get_list(passwd, Entries), - get_list(options, Entries)}. - -get_integer(Key, List) -> - case lists:keysearch(Key, 1, List) of - {value, {Key, Value}} when is_integer(Value) -> - Value; - {value, {Key, _Value}} -> - throw({error, "Bad Value in Config for " ++ atom_to_list(Key)}); - false -> - throw({error, "No Entry in Config for " ++ atom_to_list(Key)}) - end. - -get_list(Key, List) -> - case lists:keysearch(Key, 1, List) of - {value, {Key, Value}} when is_list(Value) -> - Value; - {value, {Key, _Value}} -> - throw({error, "Bad Value in Config for " ++ atom_to_list(Key)}); - false -> - throw({error, "No Entry in Config for " ++ atom_to_list(Key)}) - end. - %% get_atom(Key, List) -> %% case lists:keysearch(Key, 1, List) of %% {value, {Key, Value}} when is_atom(Value) -> @@ -1148,25 +1181,19 @@ get_list(Key, List) -> %% false -> %% throw({error, "No Entry in Config for " ++ atom_to_list(Key)}) %% end. - -get_hosts(Key, List) -> - lists:map(fun({Key1, {A,B,C,D}}) when is_integer(A), - is_integer(B), - is_integer(C), - is_integer(D), - Key == Key1-> - {A,B,C,D}; - ({Key1, Value}) when is_list(Value), - Key == Key1-> - Value; - ({_Else, _Value}) -> - throw({error, "Bad Hostname in config"}) - end, List). - %%% -------------------------------------------------------------------- %%% Other Stuff %%% -------------------------------------------------------------------- -bump_id(#eldap{id = Id}) when Id > ?MAX_TRANSACTION_ID -> +next_host(Host, [Host], Hosts) -> + hd(Hosts); % Wrap back to first +next_host(Host, [Host | Tail], _Hosts) -> + hd(Tail); % Take next +next_host(_Host, [], Hosts) -> + hd(Hosts); % Never connected before? (shouldn't happen) +next_host(Host, [_ | T], Hosts) -> + next_host(Host, T, Hosts). + +bump_id(#eldap{id = Id}) + when Id > (?MAX_TRANSACTION_ID) -> ?MIN_TRANSACTION_ID; -bump_id(#eldap{id = Id}) -> - Id + 1. +bump_id(#eldap{id = Id}) -> Id + 1. diff --git a/src/eldap/eldap.hrl b/src/eldap/eldap.hrl index 90d794fb8..30ec0e954 100644 --- a/src/eldap/eldap.hrl +++ b/src/eldap/eldap.hrl @@ -20,20 +20,45 @@ %%%---------------------------------------------------------------------- -define(LDAP_PORT, 389). + -define(LDAPS_PORT, 636). --record(eldap_search, {scope = wholeSubtree, - base = [], - filter, - limit = 0, - attributes = [], - types_only = false, - deref_aliases = neverDerefAliases, - timeout = 0}). +-type scope() :: baseObject | singleLevel | wholeSubtree. + +-record(eldap_search, + {scope = wholeSubtree :: scope(), + base = <<"">> :: binary(), + filter :: eldap:filter(), + limit = 0 :: non_neg_integer(), + attributes = [] :: [binary()], + types_only = false :: boolean(), + deref_aliases = neverDerefAliases :: neverDerefAliases | + derefInSearching | + derefFindingBaseObj | + derefAlways, + timeout = 0 :: non_neg_integer()}). + +-record(eldap_search_result, {entries = [] :: [eldap_entry()], + referrals = [] :: list()}). + +-record(eldap_entry, {object_name = <<>> :: binary(), + attributes = [] :: [{binary(), [binary()]}]}). +-type tlsopts() :: [{encrypt, tls | starttls | none} | + {tls_cacertfile, binary() | undefined} | + {tls_depth, non_neg_integer() | undefined} | + {tls_verify, hard | soft | false}]. --record(eldap_search_result, {entries, - referrals}). +-record(eldap_config, {servers = [] :: [binary()], + backups = [] :: [binary()], + tls_options = [] :: tlsopts(), + port = ?LDAP_PORT :: inet:port_number(), + dn = <<"">> :: binary(), + password = <<"">> :: binary(), + base = <<"">> :: binary(), + deref_aliases = never :: never | searching | + finding | always}). --record(eldap_entry, {object_name, - attributes}). +-type eldap_config() :: #eldap_config{}. +-type eldap_search() :: #eldap_search{}. +-type eldap_entry() :: #eldap_entry{}. diff --git a/src/eldap/eldap_filter.erl b/src/eldap/eldap_filter.erl index 11a37fe20..6771fc2af 100644 --- a/src/eldap/eldap_filter.erl +++ b/src/eldap/eldap_filter.erl @@ -27,8 +27,6 @@ -module(eldap_filter). %% TODO: remove this when new regexp module will be used --compile({nowarn_deprecated_function, {regexp, sub, 3}}). - -export([parse/1, parse/2, do_sub/2]). %%==================================================================== @@ -50,7 +48,9 @@ %%% {ok,{'and',[{'not',{lessOrEqual,{'AttributeValueAssertion',"uid","100"}}}, %%% {present,"mail"}]}} %%%------------------------------------------------------------------- -parse(L) when is_list(L) -> +-spec parse(binary()) -> {error, any()} | {ok, eldap:filter()}. + +parse(L) -> parse(L, []). %%%------------------------------------------------------------------- @@ -80,8 +80,12 @@ parse(L) when is_list(L) -> %%% "jid", %%% "xramtsov@gmail.com"}}]}} %%%------------------------------------------------------------------- -parse(L, SList) when is_list(L), is_list(SList) -> - case catch eldap_filter_yecc:parse(scan(L, SList)) of +-spec parse(binary(), [{binary(), binary()} | + {binary(), binary(), pos_integer()}]) -> + {error, any()} | {ok, eldap:filter()}. + +parse(L, SList) -> + case catch eldap_filter_yecc:parse(scan(binary_to_list(L), SList)) of {'EXIT', _} = Err -> {error, Err}; {error, {_, _, Msg}} -> @@ -95,13 +99,13 @@ parse(L, SList) when is_list(L), is_list(SList) -> %%==================================================================== %% Internal functions %%==================================================================== --define(do_scan(L), scan(Rest, [], [{L, 1} | check(Buf, S) ++ Result], L, S)). +-define(do_scan(L), scan(Rest, <<>>, [{L, 1} | check(Buf, S) ++ Result], L, S)). scan(L, SList) -> - scan(L, "", [], undefined, SList). + scan(L, <<"">>, [], undefined, SList). scan("=*)" ++ Rest, Buf, Result, '(', S) -> - scan(Rest, [], [{')', 1}, {'=*', 1} | check(Buf, S) ++ Result], ')', S); + 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(':='); @@ -112,35 +116,35 @@ 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) 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(Rest, <<Buf/binary, Letter>>, Result, PreviosAtom, S); scan([], Buf, Result, _, S) -> lists:reverse(check(Buf, S) ++ Result). -check([], _) -> +check(<<>>, _) -> []; check(Buf, S) -> - [{str, 1, do_sub(lists:reverse(Buf), S)}]. + [{str, 1, binary_to_list(do_sub(Buf, S))}]. -define(MAX_RECURSION, 100). +-spec do_sub(binary(), [{binary(), binary()} | + {binary(), binary(), pos_integer()}]) -> binary(). + do_sub(S, []) -> S; - -do_sub([], _) -> - []; - +do_sub(<<>>, _) -> + <<>>; do_sub(S, [{RegExp, New} | T]) -> Result = do_sub(S, {RegExp, replace_amps(New)}, 1), do_sub(Result, T); - do_sub(S, [{RegExp, New, Times} | T]) -> Result = do_sub(S, {RegExp, replace_amps(New), Times}, 1), do_sub(Result, T). @@ -178,9 +182,10 @@ do_sub(S, {RegExp, New, Times}, Iter) -> erlang:error(bad_regexp) end. -replace_amps(String) -> - lists:flatmap( - fun($&) -> "\\&"; - ($\\) -> "\\\\"; - (Chr) -> [Chr] - end, String). +replace_amps(Bin) -> + list_to_binary( + lists:flatmap( + fun($&) -> "\\&"; + ($\\) -> "\\\\"; + (Chr) -> [Chr] + end, binary_to_list(Bin))). diff --git a/src/eldap/eldap_filter_yecc.yrl b/src/eldap/eldap_filter_yecc.yrl index a8f7970bf..a70ea3e74 100644 --- a/src/eldap/eldap_filter_yecc.yrl +++ b/src/eldap/eldap_filter_yecc.yrl @@ -67,5 +67,5 @@ final(Value) -> {final, Value}. 'any'(Token, Value) -> [Token, {any, Value}]. xattr(Value) -> {type, Value}. matchingrule(Value) -> {matchingRule, Value}. -value_of(Token) -> element(3, Token). +value_of(Token) -> iolist_to_binary(element(3, Token)). flatten(List) -> lists:flatten(List). diff --git a/src/eldap/eldap_pool.erl b/src/eldap/eldap_pool.erl index d256ca0a9..1f52999ef 100644 --- a/src/eldap/eldap_pool.erl +++ b/src/eldap/eldap_pool.erl @@ -25,24 +25,15 @@ %%%------------------------------------------------------------------- -module(eldap_pool). + -author('xram@jabber.ru'). %% API --export([ - start_link/7, - bind/3, - search/2, - modify_passwd/3 - ]). +-export([start_link/7, bind/3, search/2, + modify_passwd/3]). -include("ejabberd.hrl"). --ifdef(SSL40). --define(PG2, pg2). --else. --define(PG2, pg2_backport). --endif. - %%==================================================================== %% API %%==================================================================== @@ -55,40 +46,41 @@ search(PoolName, Opts) -> modify_passwd(PoolName, DN, Passwd) -> do_request(PoolName, {modify_passwd, [DN, Passwd]}). -start_link(Name, Hosts, Backups, Port, Rootdn, Passwd, Opts) -> +start_link(Name, Hosts, Backups, Port, Rootdn, Passwd, + Opts) -> PoolName = make_id(Name), - ?PG2:create(PoolName), - lists:foreach( - fun(Host) -> - ID = erlang:ref_to_list(make_ref()), - case catch eldap:start_link(ID, [Host|Backups], Port, - Rootdn, Passwd, Opts) of - {ok, Pid} -> - ?PG2:join(PoolName, Pid); - _ -> - error - end - end, Hosts). + pg2:create(PoolName), + lists:foreach(fun (Host) -> + ID = list_to_binary(erlang:ref_to_list(make_ref())), + case catch eldap:start_link(ID, [Host | Backups], + Port, Rootdn, Passwd, + Opts) + of + {ok, Pid} -> pg2:join(PoolName, Pid); + Err -> + ?INFO_MSG("Err = ~p", [Err]), + error + end + end, + Hosts). %%==================================================================== %% Internal functions %%==================================================================== do_request(Name, {F, Args}) -> - case ?PG2:get_closest_pid(make_id(Name)) of - Pid when is_pid(Pid) -> - case catch apply(eldap, F, [Pid | Args]) of - {'EXIT', {timeout, _}} -> - ?ERROR_MSG("LDAP request failed: timed out", []); - {'EXIT', Reason} -> - ?ERROR_MSG("LDAP request failed: eldap:~p(~p)~nReason: ~p", - [F, Args, Reason]), - {error, Reason}; - Reply -> - Reply - end; - Err -> - Err + case pg2:get_closest_pid(make_id(Name)) of + Pid when is_pid(Pid) -> + case catch apply(eldap, F, [Pid | Args]) of + {'EXIT', {timeout, _}} -> + ?ERROR_MSG("LDAP request failed: timed out", []); + {'EXIT', Reason} -> + ?ERROR_MSG("LDAP request failed: eldap:~p(~p)~nReason: ~p", + [F, Args, Reason]), + {error, Reason}; + Reply -> Reply + end; + Err -> Err end. make_id(Name) -> - list_to_atom("eldap_pool_" ++ Name). + jlib:binary_to_atom(<<"eldap_pool_", Name/binary>>). diff --git a/src/eldap/eldap_utils.erl b/src/eldap/eldap_utils.erl index 6c1c43e90..2e149d8b6 100644 --- a/src/eldap/eldap_utils.erl +++ b/src/eldap/eldap_utils.erl @@ -30,15 +30,18 @@ -export([generate_subfilter/1, find_ldap_attrs/2, get_ldap_attr/2, - usort_attrs/1, get_user_part/2, make_filter/2, get_state/2, case_insensitive_match/2, - check_filter/1, + get_opt/3, + get_opt/4, + get_config/2, + decode_octet_string/3, uids_domain_subst/2]). -include("ejabberd.hrl"). +-include("eldap.hrl"). %% Generate an 'or' LDAP query on one or several attributes %% If there is only one attribute @@ -46,27 +49,34 @@ generate_subfilter([UID]) -> subfilter(UID); %% If there is several attributes generate_subfilter(UIDs) -> - "(|" ++ [subfilter(UID) || UID <- UIDs] ++ ")". + iolist_to_binary(["(|", [subfilter(UID) || UID <- UIDs], ")"]). %% Subfilter for a single attribute + subfilter({UIDAttr, UIDAttrFormat}) -> - "(" ++ UIDAttr ++ "=" ++ UIDAttrFormat ++ ")"; %% The default UiDAttrFormat is %u + <<$(, UIDAttr/binary, $=, UIDAttrFormat/binary, $)>>; +%% The default UiDAttrFormat is <<"%u">> subfilter({UIDAttr}) -> - "(" ++ UIDAttr ++ "=" ++ "%u)". + <<$(, UIDAttr/binary, $=, "%u)">>. %% Not tail-recursive, but it is not very terribly. %% It stops finding on the first not empty value. +-spec find_ldap_attrs([{binary()} | {binary(), binary()}], + [{binary(), [binary()]}]) -> <<>> | {binary(), binary()}. + find_ldap_attrs([{Attr} | Rest], Attributes) -> - find_ldap_attrs([{Attr, "%u"} | Rest], Attributes); + find_ldap_attrs([{Attr, <<"%u">>} | Rest], Attributes); find_ldap_attrs([{Attr, Format} | Rest], Attributes) -> case get_ldap_attr(Attr, Attributes) of - Value when is_list(Value), Value /= "" -> + Value when is_binary(Value), Value /= <<>> -> {Value, Format}; _ -> find_ldap_attrs(Rest, Attributes) end; find_ldap_attrs([], _) -> - "". + <<>>. + +-spec get_ldap_attr(binary(), [{binary(), [binary()]}]) -> binary(). get_ldap_attr(LDAPAttr, Attributes) -> Res = lists:filter( @@ -75,31 +85,26 @@ get_ldap_attr(LDAPAttr, Attributes) -> end, Attributes), case Res of [{_, [Value|_]}] -> Value; - _ -> "" + _ -> <<>> end. - -usort_attrs(Attrs) when is_list(Attrs) -> - lists:usort(Attrs); -usort_attrs(_) -> - []. +-spec get_user_part(binary(), binary()) -> {ok, binary()} | {error, badmatch}. get_user_part(String, Pattern) -> F = fun(S, P) -> - First = string:str(P, "%u"), - TailLength = length(P) - (First+1), - string:sub_string(S, First, length(S) - TailLength) + First = str:str(P, <<"%u">>), + TailLength = byte_size(P) - (First+1), + str:sub_string(S, First, byte_size(S) - TailLength) end, case catch F(String, Pattern) of {'EXIT', _} -> {error, badmatch}; Result -> - case catch ejabberd_regexp:replace(Pattern, "%u", Result) of + case catch ejabberd_regexp:replace(Pattern, <<"%u">>, Result) of {'EXIT', _} -> {error, badmatch}; StringRes -> - case (string:to_lower(StringRes) == - string:to_lower(String)) of + case case_insensitive_match(StringRes, String) of true -> {ok, Result}; false -> @@ -108,20 +113,25 @@ get_user_part(String, Pattern) -> end end. +-spec make_filter([{binary(), [binary()]}], [{binary(), binary()}]) -> any(). + make_filter(Data, UIDs) -> - NewUIDs = [{U, eldap_filter:do_sub(UF, [{"%u", "*%u*", 1}])} || {U, UF} <- UIDs], + NewUIDs = [{U, eldap_filter:do_sub( + UF, [{<<"%u">>, <<"*%u*">>, 1}])} || {U, UF} <- UIDs], Filter = lists:flatmap( fun({Name, [Value | _]}) -> case Name of - "%u" when Value /= "" -> + <<"%u">> when Value /= <<"">> -> case eldap_filter:parse( - lists:flatten(generate_subfilter(NewUIDs)), - [{"%u", Value}]) of + generate_subfilter(NewUIDs), + [{<<"%u">>, Value}]) of {ok, F} -> [F]; _ -> [] end; - _ when Value /= "" -> - [eldap:substrings(Name, [{any, Value}])]; + _ when Value /= <<"">> -> + [eldap:substrings( + Name, + [{any, Value}])]; _ -> [] end @@ -133,9 +143,11 @@ make_filter(Data, UIDs) -> eldap:'and'(Filter) end. +-spec case_insensitive_match(binary(), binary()) -> boolean(). + case_insensitive_match(X, Y) -> - X1 = stringprep:tolower(X), - Y1 = stringprep:tolower(Y), + X1 = str:to_lower(X), + Y1 = str:to_lower(Y), if X1 == Y1 -> true; true -> false @@ -149,22 +161,194 @@ get_state(Server, Module) -> %% we look from alias domain (%d) and make the substitution %% with the actual host domain %% This help when you need to configure many virtual domains. +-spec uids_domain_subst(binary(), [{binary(), binary()}]) -> + [{binary(), binary()}]. + uids_domain_subst(Host, UIDs) -> lists:map(fun({U,V}) -> - {U, eldap_filter:do_sub(V,[{"%d", Host}])}; + {U, eldap_filter:do_sub(V,[{<<"%d">>, Host}])}; (A) -> A end, UIDs). -check_filter(undefined) -> - ok; -check_filter(Filter) -> - case eldap_filter:parse(Filter) of - {ok, _} -> - ok; - Err -> - ?ERROR_MSG("failed to parse LDAP filter:~n" - "** Filter: ~p~n" - "** Reason: ~p", - [Filter, Err]) +-spec get_opt({atom(), binary()}, list(), fun()) -> any(). + +get_opt({Key, Host}, Opts, F) -> + get_opt({Key, Host}, Opts, F, undefined). + +-spec get_opt({atom(), binary()}, list(), fun(), any()) -> any(). + +get_opt({Key, Host}, Opts, F, Default) -> + case gen_mod:get_opt(Key, Opts, F, undefined) of + undefined -> + ejabberd_config:get_local_option( + {Key, Host}, F, Default); + Val -> + Val end. + +-spec get_config(binary(), list()) -> eldap_config(). + +get_config(Host, Opts) -> + Servers = get_opt({ldap_servers, Host}, Opts, + fun(L) -> + [iolist_to_binary(H) || H <- L] + end, [<<"localhost">>]), + Backups = get_opt({ldap_backups, Host}, Opts, + fun(L) -> + [iolist_to_binary(H) || H <- L] + end, []), + Encrypt = get_opt({ldap_encrypt, Host}, Opts, + fun(tls) -> tls; + (starttls) -> starttls; + (none) -> none + end, none), + TLSVerify = get_opt({ldap_tls_verify, Host}, Opts, + fun(hard) -> hard; + (soft) -> soft; + (false) -> false + end, false), + TLSCAFile = get_opt({ldap_tls_cacertfile, Host}, Opts, + fun iolist_to_binary/1), + TLSDepth = get_opt({ldap_tls_depth, Host}, Opts, + fun(I) when is_integer(I), I>=0 -> I end), + Port = get_opt({ldap_port, Host}, Opts, + fun(I) when is_integer(I), I>0 -> I end, + case Encrypt of + tls -> ?LDAPS_PORT; + starttls -> ?LDAP_PORT; + _ -> ?LDAP_PORT + end), + RootDN = get_opt({ldap_rootdn, Host}, Opts, + fun iolist_to_binary/1, + <<"">>), + Password = get_opt({ldap_password, Host}, Opts, + fun iolist_to_binary/1, + <<"">>), + Base = get_opt({ldap_base, Host}, Opts, + fun iolist_to_binary/1, + <<"">>), + DerefAliases = get_opt({deref_aliases, Host}, Opts, + fun(never) -> never; + (searching) -> searching; + (finding) -> finding; + (always) -> always + end, never), + #eldap_config{servers = Servers, + backups = Backups, + tls_options = [{encrypt, Encrypt}, + {tls_verify, TLSVerify}, + {tls_cacertfile, TLSCAFile}, + {tls_depth, TLSDepth}], + port = Port, + dn = RootDN, + password = Password, + base = Base, + deref_aliases = DerefAliases}. + +%%---------------------------------------- +%% Borrowed from asn1rt_ber_bin_v2.erl +%%---------------------------------------- + +%%% The tag-number for universal types +-define(N_BOOLEAN, 1). +-define(N_INTEGER, 2). +-define(N_BIT_STRING, 3). +-define(N_OCTET_STRING, 4). +-define(N_NULL, 5). +-define(N_OBJECT_IDENTIFIER, 6). +-define(N_OBJECT_DESCRIPTOR, 7). +-define(N_EXTERNAL, 8). +-define(N_REAL, 9). +-define(N_ENUMERATED, 10). +-define(N_EMBEDDED_PDV, 11). +-define(N_SEQUENCE, 16). +-define(N_SET, 17). +-define(N_NumericString, 18). +-define(N_PrintableString, 19). +-define(N_TeletexString, 20). +-define(N_VideotexString, 21). +-define(N_IA5String, 22). +-define(N_UTCTime, 23). +-define(N_GeneralizedTime, 24). +-define(N_GraphicString, 25). +-define(N_VisibleString, 26). +-define(N_GeneralString, 27). +-define(N_UniversalString, 28). +-define(N_BMPString, 30). + +decode_octet_string(Buffer, Range, Tags) -> +% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}), + decode_restricted_string(Buffer, Range, Tags). + +decode_restricted_string(Tlv, Range, TagsIn) -> + Val = match_tags(Tlv, TagsIn), + Val2 = + case Val of + PartList = [_H|_T] -> % constructed val + collect_parts(PartList); + Bin -> + Bin + end, + check_and_convert_restricted_string(Val2, Range). + +check_and_convert_restricted_string(Val, Range) -> + {StrLen,NewVal} = if is_binary(Val) -> + {size(Val), Val}; + true -> + {length(Val), list_to_binary(Val)} + end, + case Range of + [] -> % No length constraint + NewVal; + {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint + NewVal; + {{Lb,_Ub},[]} when StrLen >= Lb -> + NewVal; + {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min -> + NewVal; + {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; + StrLen =< Ub2, StrLen >= Lb2 -> + NewVal; + StrLen -> % fixed length constraint + NewVal; + {_,_} -> + exit({error,{asn1,{length,Range,Val}}}); + _Len when is_integer(_Len) -> + exit({error,{asn1,{length,Range,Val}}}); + _ -> % some strange constraint that we don't support yet + NewVal + end. + +%%---------------------------------------- +%% Decode the in buffer to bits +%%---------------------------------------- +match_tags({T,V},[T]) -> + V; +match_tags({T,V}, [T|Tt]) -> + match_tags(V,Tt); +match_tags([{T,V}],[T|Tt]) -> + match_tags(V, Tt); +match_tags(Vlist = [{T,_V}|_], [T]) -> + Vlist; +match_tags(Tlv, []) -> + Tlv; +match_tags({Tag,_V},[T|_Tt]) -> + {error,{asn1,{wrong_tag,{Tag,T}}}}. + +collect_parts(TlvList) -> + collect_parts(TlvList,[]). + +collect_parts([{_,L}|Rest],Acc) when is_list(L) -> + collect_parts(Rest,[collect_parts(L)|Acc]); +collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],_Acc) -> + collect_parts_bit(Rest,[Bits],Unused); +collect_parts([{_T,V}|Rest],Acc) -> + collect_parts(Rest,[V|Acc]); +collect_parts([],Acc) -> + list_to_binary(lists:reverse(Acc)). + +collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],Acc,Uacc) -> + collect_parts_bit(Rest,[Bits|Acc],Unused+Uacc); +collect_parts_bit([],Acc,Uacc) -> + list_to_binary([Uacc|lists:reverse(Acc)]). |