-module(eldap). %%% -------------------------------------------------------------------- %%% Created: 12 Oct 2000 by Tobbe %%% Function: Erlang client LDAP implementation according RFC 2251,2253 %%% and 2255. The interface is based on RFC 1823, and %%% draft-ietf-asid-ldap-c-api-00.txt %%% %%% Copyright (c) 2010 Torbjorn Tornkvist %%% Copyright Ericsson AB 2011-2013. All Rights Reserved. %%% See MIT-LICENSE at the top dir for licensing information. %%% -------------------------------------------------------------------- -vc('$Id$ '). -export([open/1,open/2,simple_bind/3,controlling_process/2, start_tls/2, start_tls/3, getopts/2, baseObject/0,singleLevel/0,wholeSubtree/0,close/1, equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, extensibleMatch/2, approxMatch/2,search/2,substrings/2,present/1, 'and'/1,'or'/1,'not'/1,modify/3, mod_add/2, mod_delete/2, mod_replace/2, add/3, delete/2, modify_dn/5,parse_dn/1, parse_ldap_url/1]). -export([neverDerefAliases/0, derefInSearching/0, derefFindingBaseObj/0, derefAlways/0]). %% for upgrades -export([loop/2]). -import(lists,[concat/1]). -include("ELDAPv3.hrl"). -include("eldap.hrl"). -define(LDAP_VERSION, 3). -define(LDAP_PORT, 389). -define(LDAPS_PORT, 636). -record(eldap, {version = ?LDAP_VERSION, host, % Host running LDAP server port = ?LDAP_PORT, % The LDAP server port fd, % Socket filedescriptor. prev_fd, % Socket that was upgraded by start_tls binddn = "", % Name of the entry to bind as passwd, % Password for (above) entry id = 0, % LDAP Request ID log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication ldaps = false, % LDAP/LDAPS using_tls = false, % true if LDAPS or START_TLS executed tls_opts = [], % ssl:ssloption() tcp_opts = [] % inet6 support }). %%% For debug purposes %%-define(PRINT(S, A), io:fwrite("~w(~w): " ++ S, [?MODULE,?LINE|A])). -define(PRINT(S, A), true). -define(elog(S, A), error_logger:info_msg("~w(~w): "++S,[?MODULE,?LINE|A])). %%% ==================================================================== %%% Exported interface %%% ==================================================================== %%% -------------------------------------------------------------------- %%% open(Hosts [,Opts] ) %%% -------------------- %%% Setup a connection to on of the Hosts in the argument %%% list. Stop at the first successful connection attempt. %%% Valid Opts are: Where: %%% %%% {port, Port} - Port is the port number %%% {log, F} - F(LogLevel, FormatString, ListOfArgs) %%% {timeout, milliSec} - Server request timeout %%% %%% -------------------------------------------------------------------- open(Hosts) -> open(Hosts, []). open(Hosts, Opts) when is_list(Hosts), is_list(Opts) -> Self = self(), Pid = spawn_link(fun() -> init(Hosts, Opts, Self) end), recv(Pid). %%% -------------------------------------------------------------------- %%% Upgrade an existing connection to tls %%% -------------------------------------------------------------------- start_tls(Handle, TlsOptions) -> start_tls(Handle, TlsOptions, infinity). start_tls(Handle, TlsOptions, Timeout) -> send(Handle, {start_tls,TlsOptions,Timeout}), recv(Handle). %%% -------------------------------------------------------------------- %%% Ask for option values on the socket. %%% Warning: This is an undocumented function for testing purposes only. %%% Use at own risk... %%% -------------------------------------------------------------------- getopts(Handle, OptNames) when is_pid(Handle), is_list(OptNames) -> send(Handle, {getopts, OptNames}), recv(Handle). %%% -------------------------------------------------------------------- %%% Shutdown connection (and process) asynchronous. %%% -------------------------------------------------------------------- close(Handle) when is_pid(Handle) -> send(Handle, close). %%% -------------------------------------------------------------------- %%% Set who we should link ourselves to %%% -------------------------------------------------------------------- controlling_process(Handle, Pid) when is_pid(Handle), is_pid(Pid) -> link(Pid), send(Handle, {cnt_proc, Pid}), recv(Handle). %%% -------------------------------------------------------------------- %%% Authenticate ourselves to the Directory %%% using simple authentication. %%% %%% Dn - The name of the entry to bind as %%% Passwd - The password to be used %%% %%% Returns: ok | {error, Error} %%% -------------------------------------------------------------------- simple_bind(Handle, Dn, Passwd) when is_pid(Handle) -> send(Handle, {simple_bind, Dn, Passwd}), recv(Handle). %%% -------------------------------------------------------------------- %%% Add an entry. The entry field MUST NOT exist for the AddRequest %%% to succeed. The parent of the entry MUST exist. %%% Example: %%% %%% add(Handle, %%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", %%% [{"objectclass", ["person"]}, %%% {"cn", ["Bill Valentine"]}, %%% {"sn", ["Valentine"]}, %%% {"telephoneNumber", ["545 555 00"]}] %%% ) %%% -------------------------------------------------------------------- add(Handle, Entry, Attributes) when is_pid(Handle),is_list(Entry),is_list(Attributes) -> send(Handle, {add, Entry, add_attrs(Attributes)}), recv(Handle). %%% Do sanity check ! add_attrs(Attrs) -> F = fun({Type,Vals}) when is_list(Type),is_list(Vals) -> %% Confused ? Me too... :-/ {'AddRequest_attributes',Type, Vals} end, case catch lists:map(F, Attrs) of {'EXIT', _} -> throw({error, attribute_values}); Else -> Else end. %%% -------------------------------------------------------------------- %%% Delete an entry. The entry consists of the DN of %%% the entry to be deleted. %%% Example: %%% %%% delete(Handle, %%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com" %%% ) %%% -------------------------------------------------------------------- delete(Handle, Entry) when is_pid(Handle), is_list(Entry) -> send(Handle, {delete, Entry}), recv(Handle). %%% -------------------------------------------------------------------- %%% Modify an entry. Given an entry a number of modification %%% operations can be performed as one atomic operation. %%% Example: %%% %%% modify(Handle, %%% "cn=Torbjorn Tornkvist, ou=people, o=Bluetail AB, dc=bluetail, dc=com", %%% [mod_replace("telephoneNumber", ["555 555 00"]), %%% mod_add("description", ["LDAP hacker"])] %%% ) %%% -------------------------------------------------------------------- modify(Handle, Object, Mods) when is_pid(Handle), is_list(Object), is_list(Mods) -> send(Handle, {modify, Object, Mods}), recv(Handle). %%% %%% Modification operations. %%% Example: %%% mod_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). m(Operation, Type, Values) -> #'ModifyRequest_changes_SEQOF'{ operation = Operation, modification = #'PartialAttribute'{ type = Type, vals = Values}}. %%% -------------------------------------------------------------------- %%% Modify an entry. Given an entry a number of modification %%% operations can be performed as one atomic operation. %%% Example: %%% %%% modify_dn(Handle, %%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", %%% "cn=Ben Emerson", %%% true, %%% "" %%% ) %%% -------------------------------------------------------------------- modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) when is_pid(Handle),is_list(Entry),is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) -> send(Handle, {modify_dn, Entry, NewRDN, bool_p(DelOldRDN), optional(NewSup)}), recv(Handle). %%% Sanity checks ! bool_p(Bool) when Bool==true;Bool==false -> Bool. optional([]) -> asn1_NOVALUE; optional(Value) -> Value. %%% -------------------------------------------------------------------- %%% Synchronous search of the Directory returning a %%% requested set of attributes. %%% %%% Example: %%% %%% Filter = eldap:substrings("cn", [{any,"o"}]), %%% eldap:search(S, [{base, "dc=bluetail, dc=com"}, %%% {filter, Filter}, %%% {attributes,["cn"]}])), %%% %%% Returned result: {ok, #eldap_search_result{}} %%% %%% Example: %%% %%% {ok,{eldap_search_result, %%% [{eldap_entry, %%% "cn=Magnus Froberg, dc=bluetail, dc=com", %%% [{"cn",["Magnus Froberg"]}]}, %%% {eldap_entry, %%% "cn=Torbjorn Tornkvist, dc=bluetail, dc=com", %%% [{"cn",["Torbjorn Tornkvist"]}]}], %%% []}} %%% %%% -------------------------------------------------------------------- search(Handle, A) when is_pid(Handle), is_record(A, eldap_search) -> call_search(Handle, A); search(Handle, L) when is_pid(Handle), is_list(L) -> case catch parse_search_args(L) of {error, Emsg} -> {error, Emsg}; A when is_record(A, eldap_search) -> call_search(Handle, A) end. call_search(Handle, A) -> send(Handle, {search, A}), recv(Handle). parse_search_args(Args) -> parse_search_args(Args, #eldap_search{scope = wholeSubtree, deref = derefAlways}). 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([{deref, Deref}|T],A) -> parse_search_args(T,A#eldap_search{deref = Deref}); 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([H|_],_) -> throw({error,{unknown_arg, H}}); parse_search_args([],A) -> A. %%% %%% The Scope parameter %%% baseObject() -> baseObject. singleLevel() -> singleLevel. wholeSubtree() -> wholeSubtree. %% %% The derefAliases parameter %% neverDerefAliases() -> neverDerefAliases. derefInSearching() -> derefInSearching. derefFindingBaseObj() -> derefFindingBaseObj. derefAlways() -> derefAlways. %%% %%% 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}. %%% %%% 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)}. av_assert(Desc, Value) -> #'AttributeValueAssertion'{attributeDesc = Desc, assertionValue = Value}. %%% %%% Filter to check for the presence of an attribute %%% present(Attribute) when is_list(Attribute) -> {present, Attribute}. %%% %%% A substring filter seem to be based on a pattern: %%% %%% InitValue*AnyValue*FinalValue %%% %%% where all three parts seem to be optional (at least when %%% talking with an OpenLDAP server). Thus, the arguments %%% to substrings/2 looks like this: %%% %%% Type ::= string( ) %%% SubStr ::= listof( {initial,Value} | {any,Value}, {final,Value}) %%% %%% 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 = v_substr(SubStr), {substrings,#'SubstringFilter'{type = Type, substrings = Ss}}. %%% %%% Filter for extensibleMatch %%% extensibleMatch(MatchValue, OptArgs) -> MatchingRuleAssertion = mra(OptArgs, #'MatchingRuleAssertion'{matchValue = MatchValue}), {extensibleMatch, MatchingRuleAssertion}. mra([{matchingRule,Val}|T], Ack) when is_list(Val) -> mra(T, Ack#'MatchingRuleAssertion'{matchingRule=Val}); mra([{type,Val}|T], Ack) when is_list(Val) -> mra(T, Ack#'MatchingRuleAssertion'{type=Val}); mra([{dnAttributes,true}|T], Ack) -> mra(T, Ack#'MatchingRuleAssertion'{dnAttributes="TRUE"}); mra([{dnAttributes,false}|T], Ack) -> mra(T, Ack#'MatchingRuleAssertion'{dnAttributes="FALSE"}); mra([H|_], _) -> throw({error,{extensibleMatch_arg,H}}); mra([], Ack) -> Ack. %%% -------------------------------------------------------------------- %%% Worker process. We keep track of a controlling process to %%% be able to terminate together with it. %%% -------------------------------------------------------------------- init(Hosts, Opts, Cpid) -> Data = parse_args(Opts, Cpid, #eldap{}), case try_connect(Hosts, Data) of {ok,Data2} -> send(Cpid, {ok,self()}), ?MODULE:loop(Cpid, Data2); Else -> send(Cpid, Else), unlink(Cpid), exit(Else) end. parse_args([{port, Port}|T], Cpid, Data) when is_integer(Port) -> parse_args(T, Cpid, Data#eldap{port = Port}); parse_args([{timeout, Timeout}|T], Cpid, Data) when is_integer(Timeout),Timeout>0 -> parse_args(T, Cpid, Data#eldap{timeout = Timeout}); parse_args([{anon_auth, true}|T], Cpid, Data) -> parse_args(T, Cpid, Data#eldap{anon_auth = false}); parse_args([{anon_auth, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{ssl, true}|T], Cpid, Data) -> parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true}); parse_args([{ssl, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true, tls_opts = Opts ++ Data#eldap.tls_opts}); parse_args([{sslopts, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{tcpopts, Opts}|T], Cpid, Data) when is_list(Opts) -> parse_args(T, Cpid, Data#eldap{tcp_opts = tcp_opts(Opts,Cpid,Data#eldap.tcp_opts)}); parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> parse_args(T, Cpid, Data#eldap{log = F}); parse_args([{log, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([H|_], Cpid, _) -> send(Cpid, {error,{wrong_option,H}}), unlink(Cpid), exit(wrong_option); parse_args([], _, Data) -> Data. tcp_opts([Opt|Opts], Cpid, Acc) -> Key = if is_atom(Opt) -> Opt; is_tuple(Opt) -> element(1,Opt) end, case lists:member(Key,[active,binary,deliver,list,mode,packet]) of false -> tcp_opts(Opts, Cpid, [Opt|Acc]); true -> tcp_opts_error(Opt, Cpid) end; tcp_opts([], _Cpid, Acc) -> Acc. tcp_opts_error(Opt, Cpid) -> send(Cpid, {error, {{forbidden_tcp_option,Opt}, "This option affects the eldap functionality and can't be set by user"}}), unlink(Cpid), exit(forbidden_tcp_option). %%% Try to connect to the hosts in the listed order, %%% and stop with the first one to which a successful %%% connection is made. try_connect([Host|Hosts], Data) -> TcpOpts = [{packet, asn1}, {active,false}], try do_connect(Host, Data, TcpOpts) of {ok,Fd} -> {ok,Data#eldap{host = Host, fd = Fd}}; Err -> log2(Data, "Connect: ~p failed ~p~n",[Host, Err]), try_connect(Hosts, Data) catch _:Err -> log2(Data, "Connect: ~p failed ~p~n",[Host, Err]), try_connect(Hosts, Data) end; try_connect([],_) -> {error,"connect failed"}. do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> gen_tcp:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tcp_opts, Data#eldap.timeout); do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> ssl:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tls_opts ++ Data#eldap.tcp_opts). loop(Cpid, Data) -> receive {From, {search, A}} -> {Res,NewData} = do_search(Data, A), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {modify, Obj, Mod}} -> {Res,NewData} = do_modify(Data, Obj, Mod), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {modify_dn, Obj, NewRDN, DelOldRDN, NewSup}} -> {Res,NewData} = do_modify_dn(Data, Obj, NewRDN, DelOldRDN, NewSup), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {add, Entry, Attrs}} -> {Res,NewData} = do_add(Data, Entry, Attrs), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {delete, Entry}} -> {Res,NewData} = do_delete(Data, Entry), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {simple_bind, Dn, Passwd}} -> {Res,NewData} = do_simple_bind(Data, Dn, Passwd), send(From,Res), ?MODULE:loop(Cpid, NewData); {From, {cnt_proc, NewCpid}} -> unlink(Cpid), send(From,ok), ?PRINT("New Cpid is: ~p~n",[NewCpid]), ?MODULE:loop(NewCpid, Data); {From, {start_tls,TlsOptions,Timeout}} -> {Res,NewData} = do_start_tls(Data, TlsOptions, Timeout), send(From,Res), ?MODULE:loop(Cpid, NewData); {_From, close} -> unlink(Cpid), exit(closed); {From, {getopts, OptNames}} -> Result = try [case OptName of port -> {port, Data#eldap.port}; log -> {log, Data#eldap.log}; timeout -> {timeout, Data#eldap.timeout}; ssl -> {ssl, Data#eldap.ldaps}; {sslopts, SslOptNames} when Data#eldap.using_tls==true -> case ssl:getopts(Data#eldap.fd, SslOptNames) of {ok,SslOptVals} -> {sslopts, SslOptVals}; {error,Reason} -> throw({error,Reason}) end; {sslopts, _} -> throw({error,no_tls}); {tcpopts, TcpOptNames} -> case inet:getopts(Data#eldap.fd, TcpOptNames) of {ok,TcpOptVals} -> {tcpopts, TcpOptVals}; {error,Posix} -> throw({error,Posix}) end end || OptName <- OptNames] of OptsList -> {ok,OptsList} catch throw:Error -> Error; Class:Error -> {error,{Class,Error}} end, send(From, Result), ?MODULE:loop(Cpid, Data); {Cpid, 'EXIT', Reason} -> ?PRINT("Got EXIT from Cpid, reason=~p~n",[Reason]), exit(Reason); _XX -> ?PRINT("loop got: ~p~n",[_XX]), ?MODULE:loop(Cpid, Data) end. %%% -------------------------------------------------------------------- %%% startTLS Request %%% -------------------------------------------------------------------- do_start_tls(Data=#eldap{using_tls=true}, _, _) -> {{error,tls_already_started}, Data}; do_start_tls(Data=#eldap{fd=FD} , TlsOptions, Timeout) -> case catch exec_start_tls(Data) of {ok,NewData} -> case ssl:connect(FD,TlsOptions,Timeout) of {ok, SslSocket} -> {ok, NewData#eldap{prev_fd = FD, fd = SslSocket, using_tls = true }}; {error,Error} -> {{error,Error}, Data} end; {error,Error} -> {{error,Error},Data}; Else -> {{error,Else},Data} end. -define(START_TLS_OID, "1.3.6.1.4.1.1466.20037"). exec_start_tls(Data) -> Req = #'ExtendedRequest'{requestName = ?START_TLS_OID}, Reply = request(Data#eldap.fd, Data, Data#eldap.id, {extendedReq, Req}), exec_extended_req_reply(Data, Reply). exec_extended_req_reply(Data, {ok,Msg}) when Msg#'LDAPMessage'.messageID == Data#eldap.id -> case Msg#'LDAPMessage'.protocolOp of {extendedResp, Result} -> case Result#'ExtendedResponse'.resultCode of success -> {ok,Data}; Error -> {error, {response,Error}} end; Other -> {error, Other} end; exec_extended_req_reply(_, Error) -> {error, Error}. %%% -------------------------------------------------------------------- %%% bindRequest %%% -------------------------------------------------------------------- %%% Authenticate ourselves to the directory using %%% simple authentication. do_simple_bind(Data, anon, anon) -> %% For testing do_the_simple_bind(Data, "", ""); do_simple_bind(Data, Dn, _Passwd) when Dn=="",Data#eldap.anon_auth==false -> {{error,anonymous_auth},Data}; do_simple_bind(Data, _Dn, Passwd) when Passwd=="",Data#eldap.anon_auth==false -> {{error,anonymous_auth},Data}; do_simple_bind(Data, Dn, Passwd) -> do_the_simple_bind(Data, Dn, Passwd). do_the_simple_bind(Data, Dn, Passwd) -> case catch exec_simple_bind(Data#eldap{binddn = Dn, passwd = Passwd, id = bump_id(Data)}) of {ok,NewData} -> {ok,NewData}; {error,Emsg} -> {{error,Emsg},Data}; Else -> {{error,Else},Data} end. exec_simple_bind(Data) -> Req = #'BindRequest'{version = Data#eldap.version, name = Data#eldap.binddn, authentication = {simple, Data#eldap.passwd}}, log2(Data, "bind request = ~p~n", [Req]), Reply = request(Data#eldap.fd, Data, Data#eldap.id, {bindRequest, Req}), log2(Data, "bind reply = ~p~n", [Reply]), exec_simple_bind_reply(Data, Reply). exec_simple_bind_reply(Data, {ok,Msg}) when Msg#'LDAPMessage'.messageID == Data#eldap.id -> case Msg#'LDAPMessage'.protocolOp of {bindResponse, Result} -> case Result#'BindResponse'.resultCode of success -> {ok,Data}; Error -> {error, Error} end; Other -> {error, Other} end; exec_simple_bind_reply(_, Error) -> {error, Error}. %%% -------------------------------------------------------------------- %%% searchRequest %%% -------------------------------------------------------------------- do_search(Data, A) -> case catch do_search_0(Data, A) of {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; {ok,Res,Ref,NewData} -> {{ok,polish(Res, Ref)},NewData}; {{error,Reason},NewData} -> {{error,Reason},NewData}; Else -> {ldap_closed_p(Data, Else),Data} end. %%% %%% Polish the returned search result %%% polish(Res, Ref) -> R = polish_result(Res), %%% No special treatment of referrals at the moment. #eldap_search_result{entries = R, referrals = Ref}. polish_result([H|T]) when is_record(H, 'SearchResultEntry') -> ObjectName = H#'SearchResultEntry'.objectName, F = fun({_,A,V}) -> {A,V} end, Attrs = lists:map(F, H#'SearchResultEntry'.attributes), [#eldap_entry{object_name = ObjectName, attributes = Attrs}| polish_result(T)]; polish_result([]) -> []. do_search_0(Data, A) -> Req = #'SearchRequest'{baseObject = A#eldap_search.base, scope = v_scope(A#eldap_search.scope), derefAliases = v_deref(A#eldap_search.deref), sizeLimit = 0, % no size 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) }, Id = bump_id(Data), collect_search_responses(Data#eldap{id=Id}, Req, Id). %%% The returned answers cames in one packet per entry %%% mixed with possible referals collect_search_responses(Data, Req, ID) -> S = Data#eldap.fd, log2(Data, "search request = ~p~n", [Req]), send_request(S, Data, ID, {searchRequest, Req}), Resp = recv_response(S, Data), log2(Data, "search reply = ~p~n", [Resp]), collect_search_responses(Data, S, ID, Resp, [], []). collect_search_responses(Data, S, ID, {ok,Msg}, Acc, Ref) when is_record(Msg,'LDAPMessage') -> case Msg#'LDAPMessage'.protocolOp of {'searchResDone',R} -> case R#'LDAPResult'.resultCode of success -> log2(Data, "search reply = searchResDone ~n", []), {ok,Acc,Ref,Data}; Reason -> {{error,Reason},Data} end; {'searchResEntry',R} when is_record(R,'SearchResultEntry') -> Resp = recv_response(S, Data), log2(Data, "search reply = ~p~n", [Resp]), collect_search_responses(Data, S, ID, Resp, [R|Acc], Ref); {'searchResRef',R} -> %% At the moment we don't do anyting sensible here since %% I haven't been able to trigger the server to generate %% a response like this. Resp = recv_response(S, Data), log2(Data, "search reply = ~p~n", [Resp]), collect_search_responses(Data, S, ID, Resp, Acc, [R|Ref]); Else -> throw({error,Else}) end; collect_search_responses(_, _, _, Else, _, _) -> throw({error,Else}). %%% -------------------------------------------------------------------- %%% addRequest %%% -------------------------------------------------------------------- do_add(Data, Entry, Attrs) -> case catch do_add_0(Data, Entry, Attrs) of {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; {ok,NewData} -> {ok,NewData}; Else -> {ldap_closed_p(Data, Else),Data} end. do_add_0(Data, Entry, Attrs) -> Req = #'AddRequest'{entry = Entry, attributes = Attrs}, S = Data#eldap.fd, Id = bump_id(Data), log2(Data, "add request = ~p~n", [Req]), Resp = request(S, Data, Id, {addRequest, Req}), log2(Data, "add reply = ~p~n", [Resp]), check_reply(Data#eldap{id = Id}, Resp, addResponse). %%% -------------------------------------------------------------------- %%% deleteRequest %%% -------------------------------------------------------------------- do_delete(Data, Entry) -> case catch do_delete_0(Data, Entry) of {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; {ok,NewData} -> {ok,NewData}; Else -> {ldap_closed_p(Data, Else),Data} end. do_delete_0(Data, Entry) -> S = Data#eldap.fd, Id = bump_id(Data), log2(Data, "del request = ~p~n", [Entry]), Resp = request(S, Data, Id, {delRequest, Entry}), log2(Data, "del reply = ~p~n", [Resp]), check_reply(Data#eldap{id = Id}, Resp, delResponse). %%% -------------------------------------------------------------------- %%% modifyRequest %%% -------------------------------------------------------------------- do_modify(Data, Obj, Mod) -> case catch do_modify_0(Data, Obj, Mod) of {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; {ok,NewData} -> {ok,NewData}; Else -> {ldap_closed_p(Data, Else),Data} end. do_modify_0(Data, Obj, Mod) -> v_modifications(Mod), Req = #'ModifyRequest'{object = Obj, changes = Mod}, S = Data#eldap.fd, Id = bump_id(Data), log2(Data, "modify request = ~p~n", [Req]), Resp = request(S, Data, Id, {modifyRequest, Req}), log2(Data, "modify reply = ~p~n", [Resp]), check_reply(Data#eldap{id = Id}, Resp, modifyResponse). %%% -------------------------------------------------------------------- %%% modifyDNRequest %%% -------------------------------------------------------------------- do_modify_dn(Data, Entry, NewRDN, DelOldRDN, NewSup) -> case catch do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup) of {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; {ok,NewData} -> {ok,NewData}; Else -> {ldap_closed_p(Data, Else),Data} end. do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup) -> Req = #'ModifyDNRequest'{entry = Entry, newrdn = NewRDN, deleteoldrdn = DelOldRDN, newSuperior = NewSup}, S = Data#eldap.fd, Id = bump_id(Data), log2(Data, "modify DN request = ~p~n", [Req]), Resp = request(S, Data, Id, {modDNRequest, Req}), log2(Data, "modify DN reply = ~p~n", [Resp]), check_reply(Data#eldap{id = Id}, Resp, modDNResponse). %%% -------------------------------------------------------------------- %%% Send an LDAP request and receive the answer %%% -------------------------------------------------------------------- request(S, Data, ID, Request) -> send_request(S, Data, ID, Request), recv_response(S, Data). send_request(S, Data, ID, Request) -> Message = #'LDAPMessage'{messageID = ID, protocolOp = Request}, {ok,Bytes} = 'ELDAPv3':encode('LDAPMessage', Message), case do_send(S, Data, Bytes) of {error,Reason} -> throw({gen_tcp_error,Reason}); Else -> Else end. do_send(S, Data, Bytes) when Data#eldap.using_tls == false -> gen_tcp:send(S, Bytes); do_send(S, Data, Bytes) when Data#eldap.using_tls == true -> ssl:send(S, Bytes). do_recv(S, #eldap{using_tls=false, timeout=Timeout}, Len) -> gen_tcp:recv(S, Len, Timeout); do_recv(S, #eldap{using_tls=true, timeout=Timeout}, Len) -> ssl:recv(S, Len, Timeout). recv_response(S, Data) -> case do_recv(S, Data, 0) of {ok, Packet} -> case 'ELDAPv3':decode('LDAPMessage', Packet) of {ok,Resp} -> {ok,Resp}; Error -> throw(Error) end; {error,Reason} -> throw({gen_tcp_error, Reason}) end. %%% Check for expected kind of reply check_reply(Data, {ok,Msg}, Op) when Msg#'LDAPMessage'.messageID == Data#eldap.id -> case Msg#'LDAPMessage'.protocolOp of {Op, Result} -> case Result#'LDAPResult'.resultCode of success -> {ok,Data}; Error -> {error, Error} end; Other -> {error, Other} end; check_reply(_, Error, _) -> {error, Error}. %%% -------------------------------------------------------------------- %%% 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_deref(DR = neverDerefAliases) -> DR; v_deref(DR = derefInSearching) -> DR; v_deref(DR = derefFindingBaseObj) -> DR; v_deref(DR = derefAlways ) -> DR. 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). %%% -------------------------------------------------------------------- %%% Log routines. Call a user provided log routine F. %%% -------------------------------------------------------------------- %log1(Data, Str, Args) -> log(Data, Str, Args, 1). log2(Data, Str, Args) -> log(Data, Str, Args, 2). log(Data, Str, Args, Level) when is_function(Data#eldap.log) -> catch (Data#eldap.log)(Level, Str, Args); log(_, _, _, _) -> ok. %%% -------------------------------------------------------------------- %%% Misc. routines %%% -------------------------------------------------------------------- send(To,Msg) -> To ! {self(),Msg}. recv(From) -> receive {From,Msg} -> Msg; {'EXIT', From, Reason} -> {error, {internal_error, Reason}} end. ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> %% Check if the SSL socket seems to be alive or not case catch ssl:sockname(Data#eldap.fd) of {error, _} -> ssl:close(Data#eldap.fd), {error, ldap_closed}; {ok, _} -> {error, Emsg}; _ -> %% sockname crashes if the socket pid is not alive {error, ldap_closed} end; ldap_closed_p(Data, Emsg) -> %% non-SSL socket case inet:port(Data#eldap.fd) of {error,_} -> {error, ldap_closed}; _ -> {error,Emsg} end. bump_id(Data) -> Data#eldap.id + 1. %%% -------------------------------------------------------------------- %%% parse_dn/1 - Implementation of RFC 2253: %%% %%% "UTF-8 String Representation of Distinguished Names" %%% %%% Test cases: %%% %%% The simplest case: %%% %%% 1> eldap:parse_dn("CN=Steve Kille,O=Isode Limited,C=GB"). %%% {ok,[[{attribute_type_and_value,"CN","Steve Kille"}], %%% [{attribute_type_and_value,"O","Isode Limited"}], %%% [{attribute_type_and_value,"C","GB"}]]} %%% %%% The first RDN is multi-valued: %%% %%% 2> eldap:parse_dn("OU=Sales+CN=J. Smith,O=Widget Inc.,C=US"). %%% {ok,[[{attribute_type_and_value,"OU","Sales"}, %%% {attribute_type_and_value,"CN","J. Smith"}], %%% [{attribute_type_and_value,"O","Widget Inc."}], %%% [{attribute_type_and_value,"C","US"}]]} %%% %%% Quoting a comma: %%% %%% 3> eldap:parse_dn("CN=L. Eagle,O=Sue\\, Grabbit and Runn,C=GB"). %%% {ok,[[{attribute_type_and_value,"CN","L. Eagle"}], %%% [{attribute_type_and_value,"O","Sue\\, Grabbit and Runn"}], %%% [{attribute_type_and_value,"C","GB"}]]} %%% %%% A value contains a carriage return: %%% %%% 4> eldap:parse_dn("CN=Before %%% 4> After,O=Test,C=GB"). %%% {ok,[[{attribute_type_and_value,"CN","Before\nAfter"}], %%% [{attribute_type_and_value,"O","Test"}], %%% [{attribute_type_and_value,"C","GB"}]]} %%% %%% 5> eldap:parse_dn("CN=Before\\0DAfter,O=Test,C=GB"). %%% {ok,[[{attribute_type_and_value,"CN","Before\\0DAfter"}], %%% [{attribute_type_and_value,"O","Test"}], %%% [{attribute_type_and_value,"C","GB"}]]} %%% %%% An RDN in OID form: %%% %%% 6> eldap:parse_dn("1.3.6.1.4.1.1466.0=#04024869,O=Test,C=GB"). %%% {ok,[[{attribute_type_and_value,"1.3.6.1.4.1.1466.0","#04024869"}], %%% [{attribute_type_and_value,"O","Test"}], %%% [{attribute_type_and_value,"C","GB"}]]} %%% %%% %%% -------------------------------------------------------------------- parse_dn("") -> % empty DN string {ok,[]}; parse_dn([H|_] = Str) when H=/=$, -> % 1:st name-component ! case catch parse_name(Str,[]) of {'EXIT',Reason} -> {parse_error,internal_error,Reason}; Else -> Else end. parse_name("",Acc) -> {ok,lists:reverse(Acc)}; parse_name([$,|T],Acc) -> % N:th name-component ! parse_name(T,Acc); parse_name(Str,Acc) -> {Rest,NameComponent} = parse_name_component(Str), parse_name(Rest,[NameComponent|Acc]). parse_name_component(Str) -> parse_name_component(Str,[]). parse_name_component(Str,Acc) -> case parse_attribute_type_and_value(Str) of {[$+|Rest], ATV} -> parse_name_component(Rest,[ATV|Acc]); {Rest,ATV} -> {Rest,lists:reverse([ATV|Acc])} end. parse_attribute_type_and_value(Str) -> case parse_attribute_type(Str) of {_Rest,[]} -> parse_error(expecting_attribute_type,Str); {Rest,Type} -> Rest2 = parse_equal_sign(Rest), {Rest3,Value} = parse_attribute_value(Rest2), {Rest3,{attribute_type_and_value,Type,Value}} end. -define(IS_ALPHA(X) , X>=$a,X=<$z;X>=$A,X=<$Z ). -define(IS_DIGIT(X) , X>=$0,X=<$9 ). -define(IS_SPECIAL(X) , X==$,;X==$=;X==$+;X==$<;X==$>;X==$#;X==$; ). -define(IS_QUOTECHAR(X) , X=/=$\\,X=/=$" ). -define(IS_STRINGCHAR(X) , X=/=$,,X=/=$=,X=/=$+,X=/=$<,X=/=$>,X=/=$#,X=/=$;,?IS_QUOTECHAR(X) ). -define(IS_HEXCHAR(X) , ?IS_DIGIT(X);X>=$a,X=<$f;X>=$A,X=<$F ). parse_attribute_type([H|T]) when ?IS_ALPHA(H) -> %% NB: It must be an error in the RFC in the definition %% of 'attributeType', should be: (ALPHA *keychar) {Rest,KeyChars} = parse_keychars(T), {Rest,[H|KeyChars]}; parse_attribute_type([H|_] = Str) when ?IS_DIGIT(H) -> parse_oid(Str); parse_attribute_type(Str) -> parse_error(invalid_attribute_type,Str). %%% Is a hexstring ! parse_attribute_value([$#,X,Y|T]) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> {Rest,HexString} = parse_hexstring(T), {Rest,[$#,X,Y|HexString]}; %%% Is a "quotation-sequence" ! parse_attribute_value([$"|T]) -> {Rest,Quotation} = parse_quotation(T), {Rest,[$"|Quotation]}; %%% Is a stringchar , pair or Empty ! parse_attribute_value(Str) -> parse_string(Str). parse_hexstring(Str) -> parse_hexstring(Str,[]). parse_hexstring([X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> parse_hexstring(T,[Y,X|Acc]); parse_hexstring(T,Acc) -> {T,lists:reverse(Acc)}. parse_quotation([$"|T]) -> % an empty: "" is ok ! {T,[$"]}; parse_quotation(Str) -> parse_quotation(Str,[]). %%% Parse to end of quotation parse_quotation([$"|T],Acc) -> {T,lists:reverse([$"|Acc])}; parse_quotation([X|T],Acc) when ?IS_QUOTECHAR(X) -> parse_quotation(T,[X|Acc]); parse_quotation([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> parse_quotation(T,[X,$\\|Acc]); parse_quotation([$\\,$\\|T],Acc) -> parse_quotation(T,[$\\,$\\|Acc]); parse_quotation([$\\,$"|T],Acc) -> parse_quotation(T,[$",$\\|Acc]); parse_quotation([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> parse_quotation(T,[Y,X,$\\|Acc]); parse_quotation(T,_) -> parse_error(expecting_double_quote_mark,T). parse_string(Str) -> parse_string(Str,[]). parse_string("",Acc) -> {"",lists:reverse(Acc)}; parse_string([H|T],Acc) when ?IS_STRINGCHAR(H) -> parse_string(T,[H|Acc]); parse_string([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> % is a pair ! parse_string(T,[X,$\\|Acc]); parse_string([$\\,$\\|T],Acc) -> % is a pair ! parse_string(T,[$\\,$\\|Acc]); parse_string([$\\,$" |T],Acc) -> % is a pair ! parse_string(T,[$" ,$\\|Acc]); parse_string([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> % is a pair! parse_string(T,[Y,X,$\\|Acc]); parse_string(T,Acc) -> {T,lists:reverse(Acc)}. parse_equal_sign([$=|T]) -> T; parse_equal_sign(T) -> parse_error(expecting_equal_sign,T). parse_keychars(Str) -> parse_keychars(Str,[]). parse_keychars([H|T],Acc) when ?IS_ALPHA(H) -> parse_keychars(T,[H|Acc]); parse_keychars([H|T],Acc) when ?IS_DIGIT(H) -> parse_keychars(T,[H|Acc]); parse_keychars([$-|T],Acc) -> parse_keychars(T,[$-|Acc]); parse_keychars(T,Acc) -> {T,lists:reverse(Acc)}. parse_oid(Str) -> parse_oid(Str,[]). parse_oid([H,$.|T], Acc) when ?IS_DIGIT(H) -> parse_oid(T,[$.,H|Acc]); parse_oid([H|T], Acc) when ?IS_DIGIT(H) -> parse_oid(T,[H|Acc]); parse_oid(T, Acc) -> {T,lists:reverse(Acc)}. parse_error(Emsg,Rest) -> throw({parse_error,Emsg,Rest}). %%% -------------------------------------------------------------------- %%% Parse LDAP url according to RFC 2255 %%% %%% Test case: %%% %%% 2> eldap:parse_ldap_url("ldap://10.42.126.33:389/cn=Administrative%20CA,o=Post%20Danmark,c=DK?certificateRevokationList;binary"). %%% {ok,{{10,42,126,33},389}, %%% [[{attribute_type_and_value,"cn","Administrative%20CA"}], %%% [{attribute_type_and_value,"o","Post%20Danmark"}], %%% [{attribute_type_and_value,"c","DK"}]], %%% {attributes,["certificateRevokationList;binary"]}} %%% %%% -------------------------------------------------------------------- parse_ldap_url("ldap://" ++ Rest1 = Str) -> {Rest2,HostPort} = parse_hostport(Rest1), %% Split the string into DN and Attributes+etc {Sdn,Rest3} = split_string(rm_leading_slash(Rest2),$?), case parse_dn(Sdn) of {parse_error,internal_error,_Reason} -> {parse_error,internal_error,{Str,[]}}; {parse_error,Emsg,Tail} -> Head = get_head(Str,Tail), {parse_error,Emsg,{Head,Tail}}; {ok,DN} -> %% We stop parsing here for now and leave %% 'scope', 'filter' and 'extensions' to %% be implemented later if needed. {_Rest4,Attributes} = parse_attributes(Rest3), {ok,HostPort,DN,Attributes} end. rm_leading_slash([$/|Tail]) -> Tail; rm_leading_slash(Tail) -> Tail. parse_attributes([$?|Tail]) -> case split_string(Tail,$?) of {[],Attributes} -> {[],{attributes,string:tokens(Attributes,",")}}; {Attributes,Rest} -> {Rest,{attributes,string:tokens(Attributes,",")}} end. parse_hostport(Str) -> {HostPort,Rest} = split_string(Str,$/), case split_string(HostPort,$:) of {Shost,[]} -> {Rest,{parse_host(Rest,Shost),?LDAP_PORT}}; {Shost,[$:|Sport]} -> {Rest,{parse_host(Rest,Shost), parse_port(Rest,Sport)}} end. parse_port(Rest,Sport) -> try list_to_integer(Sport) catch _:_ -> parse_error(parsing_port,Rest) end. parse_host(Rest,Shost) -> case catch validate_host(Shost) of {parse_error,Emsg,_} -> parse_error(Emsg,Rest); Host -> Host end. validate_host(Shost) -> case inet_parse:address(Shost) of {ok,Host} -> Host; _ -> case inet_parse:domain(Shost) of true -> Shost; _ -> parse_error(parsing_host,Shost) end end. split_string(Str,Key) -> Pred = fun(X) when X==Key -> false; (_) -> true end, lists:splitwith(Pred, Str). get_head(Str,Tail) -> get_head(Str,Tail,[]). %%% Should always succeed ! get_head([H|Tail],Tail,Rhead) -> lists:reverse([H|Rhead]); get_head([H|Rest],Tail,Rhead) -> get_head(Rest,Tail,[H|Rhead]).