[eldap] Initial copy of Tobbe's eldap client

Copied with Torbjorns permission from https://github.com/etnt/eldap.git

5 files changed, 2077 insertions, 0 deletions

diff --git a/lib/eldap/src/eldap.app.src b/lib/eldap/src/eldap.app.src
new file mode 100644
index 0000000000..ae43c6da4b
--- /dev/null
+++ b/lib/eldap/src/eldap.app.src
@@ -0,0 +1,9 @@
+{application, eldap,
+ [{description, "Ldap api"},
+  {vsn, "%VSN%"},
+  {modules, []},
+  {registered, []},
+  {applications, [kernel, stdlib]},
+  {mod, { eldap_app, []}},
+  {env, []}
+]}.
diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl
new file mode 100644
index 0000000000..7c9c02d681
--- /dev/null
+++ b/lib/eldap/src/eldap.erl
@@ -0,0 +1,1078 @@
+-module(eldap).
+%%% --------------------------------------------------------------------
+%%% Created:  12 Oct 2000 by Tobbe <[email protected]>
+%%% 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
+%%% See MIT-LICENSE at the top dir for licensing information.
+%%% --------------------------------------------------------------------
+-vc('$Id$ ').
+-export([open/1,open/2,simple_bind/3,controlling_process/2,
+	 baseObject/0,singleLevel/0,wholeSubtree/0,close/1,
+	 equalityMatch/2,greaterOrEqual/2,lessOrEqual/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]).
+
+-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.
+		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
+		use_tls = false      % LDAP/LDAPS
+	       }).
+
+%%% 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} - 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).
+
+%%% --------------------------------------------------------------------
+%%% 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",
+%%%         [replace("telephoneNumber", ["555 555 00"]),
+%%%          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:
+%%%            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("sn", [{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}).
+
+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([H|_],_) ->
+    throw({error,{unknown_arg, H}});
+parse_search_args([],A) ->
+    A.
+
+%%%
+%%% 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}.
+
+%%%
+%%% 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( <attribute> )
+%%% 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 = {'SubstringFilter_substrings',v_substr(SubStr)},
+    {substrings,#'SubstringFilter'{type = Type,
+				   substrings = Ss}}.
+
+%%% --------------------------------------------------------------------
+%%% 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()}),
+ 	    put(req_timeout, Data#eldap.timeout), % kludge...
+	    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{use_tls = true});
+parse_args([{ssl, _}|T], Cpid, Data) ->
+    parse_args(T, Cpid, Data);
+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}}),
+    exit(wrong_option);
+parse_args([], _, Data) ->
+    Data.
+
+%%% 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}],
+    case do_connect(Host, Data, TcpOpts) of
+	{ok,Fd} -> {ok,Data#eldap{host = Host, fd   = Fd}};
+	_       -> try_connect(Hosts, Data)
+    end;
+try_connect([],_) ->
+    {error,"connect failed"}.
+
+do_connect(Host, Data, Opts) when Data#eldap.use_tls == false ->
+    gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout);
+do_connect(Host, Data, Opts) when Data#eldap.use_tls == true ->
+    ssl:connect(Host, Data#eldap.port, [{verify,0}|Opts]).
+
+
+loop(Cpid, Data) ->
+    receive
+
+	{From, {search, A}} ->
+	    {Res,NewData} = do_search(Data, A),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {modify, Obj, Mod}} ->
+	    {Res,NewData} = do_modify(Data, Obj, Mod),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {modify_dn, Obj, NewRDN, DelOldRDN, NewSup}} ->
+	    {Res,NewData} = do_modify_dn(Data, Obj, NewRDN, DelOldRDN, NewSup),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {add, Entry, Attrs}} ->
+	    {Res,NewData} = do_add(Data, Entry, Attrs),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {delete, Entry}} ->
+	    {Res,NewData} = do_delete(Data, Entry),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {simple_bind, Dn, Passwd}} ->
+	    {Res,NewData} = do_simple_bind(Data, Dn, Passwd),
+	    send(From,Res),
+	    loop(Cpid, NewData);
+
+	{From, {cnt_proc, NewCpid}} ->
+	    unlink(Cpid),
+	    send(From,ok),
+	    ?PRINT("New Cpid is: ~p~n",[NewCpid]),
+	    loop(NewCpid, Data);
+
+	{_From, close} ->
+	    unlink(Cpid),
+	    exit(closed);
+
+	{Cpid, 'EXIT', Reason} ->
+	    ?PRINT("Got EXIT from Cpid, reason=~p~n",[Reason]),
+	    exit(Reason);
+
+	_XX ->
+	    ?PRINT("loop got: ~p~n",[_XX]),
+	    loop(Cpid, Data)
+
+    end.
+
+%%% --------------------------------------------------------------------
+%%% 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};
+	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 = neverDerefAliases,
+			   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} when R#'LDAPResult'.resultCode == success ->
+	    log2(Data, "search reply = searchResDone ~n", []),
+	    {ok,Acc,Ref,Data};
+	{'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} = asn1rt:encode('ELDAPv3', '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.use_tls == false ->
+    gen_tcp:send(S, Bytes);
+do_send(S, Data, Bytes) when Data#eldap.use_tls == true ->
+    ssl:send(S, Bytes).
+
+do_recv(S, Data, Len, Timeout) when Data#eldap.use_tls == false ->
+    gen_tcp:recv(S, Len, Timeout);
+do_recv(S, Data, Len, Timeout) when Data#eldap.use_tls == true ->
+    ssl:recv(S, Len, Timeout).
+
+recv_response(S, Data) ->
+    Timeout = get(req_timeout), % kludge...
+    case do_recv(S, Data, 0, Timeout) of
+	{ok, Packet} ->
+	    check_tag(Packet),
+	    case asn1rt:decode('ELDAPv3', 'LDAPMessage', Packet) of
+		{ok,Resp} -> {ok,Resp};
+		Error     -> throw(Error)
+	    end;
+	{error,Reason} ->
+	    throw({gen_tcp_error, Reason});
+	Error ->
+	    throw(Error)
+    end.
+
+%%% Sanity check of received packet
+check_tag(Data) ->
+    case asn1rt_ber_bin:decode_tag(b2l(Data)) of
+	{_Tag, Data1, _Rb} ->
+	    case asn1rt_ber_bin:decode_length(b2l(Data1)) of
+		{{_Len, _Data2}, _Rb2} -> ok;
+		_ -> throw({error,decoded_tag_length})
+	    end;
+	_ -> throw({error,decoded_tag})
+    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(_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).
+
+
+%%% --------------------------------------------------------------------
+%%% 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 end.
+
+ldap_closed_p(Data, Emsg) when Data#eldap.use_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) ->
+    case list_to_integer(Sport) of
+	Port when is_integer(Port) -> Port;
+	_ -> 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]).
+
+b2l(B) when is_binary(B) -> B;
+b2l(L) when is_list(L)   -> list_to_binary(L).
+
diff --git a/lib/eldap/src/eldap_app.erl b/lib/eldap/src/eldap_app.erl
new file mode 100644
index 0000000000..fa253664ea
--- /dev/null
+++ b/lib/eldap/src/eldap_app.erl
@@ -0,0 +1,16 @@
+-module(eldap_app).
+
+-behaviour(application).
+
+%% Application callbacks
+-export([start/2, stop/1]).
+
+%% ===================================================================
+%% Application callbacks
+%% ===================================================================
+
+start(_StartType, _StartArgs) ->
+    eldap_sup:start_link().
+
+stop(_State) ->
+    ok.
diff --git a/lib/eldap/src/eldap_fsm.erl b/lib/eldap/src/eldap_fsm.erl
new file mode 100644
index 0000000000..b757d3d54f
--- /dev/null
+++ b/lib/eldap/src/eldap_fsm.erl
@@ -0,0 +1,946 @@
+-module(eldap_fsm).
+%%% --------------------------------------------------------------------
+%%% Created:  12 Oct 2000 by Tobbe
+%%% Function: Erlang client LDAP implementation according RFC 2251.
+%%%           The interface is based on RFC 1823, and
+%%%           draft-ietf-asid-ldap-c-api-00.txt
+%%%
+%%% Copyright (C) 2000  Torbjn Tnkvist
+%%% Copyright (c) 2010 Torbjorn Tornkvist <[email protected]>
+%%% See MIT-LICENSE at the top dir for licensing information.
+%%%
+%%% Modified by Sean Hinde <[email protected]> 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
+%%% multiple users to call by name if so desired.
+%%%
+%%% Can be configured with start_link parameters or use a config file to get
+%%% host to connect to, dn, password, log function etc.
+%%% --------------------------------------------------------------------
+
+
+%%%----------------------------------------------------------------------
+%%% LDAP Client state machine.
+%%% Possible states are:
+%%%     connecting - actually disconnected, but retrying periodically
+%%%     wait_bind_response  - connected and sent bind request
+%%%     active - bound to LDAP Server and ready to handle commands
+%%%----------------------------------------------------------------------
+
+%%-compile(export_all).
+%%-export([Function/Arity, ...]).
+
+-behaviour(gen_fsm).
+
+%% External exports
+-export([start_link/1, start_link/5, 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,
+	 'and'/1,'or'/1,'not'/1,modify/3, mod_add/2, mod_delete/2,
+	 mod_replace/2, add/3, delete/2, modify_dn/5]).
+-export([debug_level/2, get_status/1]).
+
+%% gen_fsm callbacks
+-export([init/1, connecting/2,
+	 connecting/3, wait_bind_response/3, active/3, handle_event/3,
+	 handle_sync_event/4, handle_info/3, terminate/3, code_change/4]).
+
+
+-import(lists,[concat/1]).
+
+-include("ELDAPv3.hrl").
+-include("eldap.hrl").
+
+-define(LDAP_VERSION, 3).
+-define(RETRY_TIMEOUT, 5000).
+-define(BIND_TIMEOUT, 10000).
+-define(CMD_TIMEOUT, 5000).
+-define(MAX_TRANSACTION_ID, 65535).
+-define(MIN_TRANSACTION_ID, 0).
+
+-record(eldap, {version = ?LDAP_VERSION,
+		hosts,	      % Possible hosts running LDAP servers
+		host = null,  % Connected Host LDAP server
+		port = 389 ,  % The LDAP server port
+		fd = null,    % Socket filedescriptor.
+		rootdn = "",  % Name of the entry to bind as
+		passwd,       % Password for (above) entry
+		id = 0,       % LDAP Request ID
+		log,          % User provided log function
+		bind_timer,   % Ref to bind timeout
+		dict,         % dict holding operation params and results
+		debug_level   % Integer debug/logging level
+	       }).
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link(Name) ->
+    Reg_name = list_to_atom("eldap_" ++ Name),
+    gen_fsm:start_link({local, Reg_name}, ?MODULE, [], []).
+
+start_link(Name, Hosts, Port, Rootdn, Passwd) ->
+    Log = fun(_N, Fmt, Args) -> io:format("---- " ++ Fmt, [Args]) end,
+    Reg_name = list_to_atom("eldap_" ++ Name),
+    gen_fsm:start_link({local, Reg_name}, ?MODULE, {Hosts, Port, Rootdn, Passwd, Log}, []).
+
+start_link(Name, Hosts, Port, Rootdn, Passwd, Log) ->
+    Reg_name = list_to_atom("eldap_" ++ Name),
+    gen_fsm:start_link({local, Reg_name}, ?MODULE, {Hosts, Port, Rootdn, Passwd, Log}, []).
+
+%%% --------------------------------------------------------------------
+%%% Set Debug Level. 0 - none, 1 - errors, 2 - ldap events
+%%% --------------------------------------------------------------------
+debug_level(Handle, N) when is_integer(N) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_all_state_event(Handle1, {debug_level,N}).
+
+%%% --------------------------------------------------------------------
+%%% Get status of connection.
+%%% --------------------------------------------------------------------
+get_status(Handle) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_all_state_event(Handle1, get_status).
+
+%%% --------------------------------------------------------------------
+%%% Shutdown connection (and process) asynchronous.
+%%% --------------------------------------------------------------------
+close(Handle) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:send_all_state_event(Handle1, close).
+
+%%% --------------------------------------------------------------------
+%%% 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_list(Entry),is_list(Attributes) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_event(Handle1, {add, Entry, add_attrs(Attributes)}).
+
+%%% 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_list(Entry) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_event(Handle1, {delete, Entry}).
+
+%%% --------------------------------------------------------------------
+%%% 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",
+%%%         [replace("telephoneNumber", ["555 555 00"]),
+%%%          add("description", ["LDAP hacker"])]
+%%%        )
+%%% --------------------------------------------------------------------
+modify(Handle, Object, Mods) when is_list(Object), is_list(Mods) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_event(Handle1, {modify, Object, Mods}).
+
+%%%
+%%% 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).
+
+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_list(Entry), is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_event(Handle1, {modify_dn, Entry, NewRDN, bool_p(DelOldRDN), optional(NewSup)}).
+
+%%% 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("sn", [{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_record(A, eldap_search) ->
+    call_search(Handle, A);
+search(Handle, L) when is_list(Handle), 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)
+    end.
+
+call_search(Handle, A) ->
+    Handle1 = get_handle(Handle),
+    gen_fsm:sync_send_event(Handle1, {search, A}).
+
+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([H|_T],_A) ->
+    throw({error,{unknown_arg, H}});
+parse_search_args([],A) ->
+    A.
+
+%%%
+%%% 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}.
+
+%%%
+%%% 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( <attribute> )
+%%% 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 = {'SubstringFilter_substrings',v_substr(SubStr)},
+    {substrings,#'SubstringFilter'{type = Type,
+				   substrings = Ss}}.
+
+
+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).
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_fsm
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, StateName, StateData}          |
+%%          {ok, StateName, StateData, Timeout} |
+%%          ignore                              |
+%%          {stop, StopReason}
+%% I use the trick of setting a timeout of 0 to pass control into the
+%% process.
+%%----------------------------------------------------------------------
+init([]) ->
+    case get_config() of
+	{ok, Hosts, Rootdn, Passwd, Log} ->
+	    init({Hosts, Rootdn, Passwd, Log});
+	{error, Reason} ->
+	    {stop, Reason}
+    end;
+init({Hosts, Port, Rootdn, Passwd, Log}) ->
+    {ok, connecting, #eldap{hosts = Hosts,
+			    port = Port,
+			    rootdn = Rootdn,
+			    passwd = Passwd,
+			    id = 0,
+			    log = Log,
+			    dict = dict:new(),
+			    debug_level = 0}, 0}.
+
+%%----------------------------------------------------------------------
+%% Func: StateName/2
+%% Called when gen_fsm:send_event/2,3 is invoked (async)
+%% Returns: {next_state, NextStateName, NextStateData}          |
+%%          {next_state, NextStateName, NextStateData, Timeout} |
+%%          {stop, Reason, NewStateData}
+%%----------------------------------------------------------------------
+connecting(timeout, S) ->
+    {ok, NextState, NewS} = connect_bind(S),
+    {next_state, NextState, NewS}.
+
+%%----------------------------------------------------------------------
+%% Func: StateName/3
+%% Called when gen_fsm:sync_send_event/2,3 is invoked.
+%% Returns: {next_state, NextStateName, NextStateData}            |
+%%          {next_state, NextStateName, NextStateData, Timeout}   |
+%%          {reply, Reply, NextStateName, NextStateData}          |
+%%          {reply, Reply, NextStateName, NextStateData, Timeout} |
+%%          {stop, Reason, NewStateData}                          |
+%%          {stop, Reason, Reply, NewStateData}
+%%----------------------------------------------------------------------
+connecting(_Event, _From, S) ->
+    Reply = {error, connecting},
+    {reply, Reply, connecting, S}.
+
+wait_bind_response(_Event, _From, S) ->
+    Reply = {error, wait_bind_response},
+    {reply, Reply, wait_bind_response, S}.
+
+active(Event, From, S) ->
+    case catch send_command(Event, From, S) of
+	{ok, NewS} ->
+	    {next_state, active, NewS};
+	{error, Reason} ->
+	    {reply, {error, Reason}, active, S};
+	{'EXIT', Reason} ->
+	    {reply, {error, Reason}, active, S}
+    end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_event/3
+%% Called when gen_fsm:send_all_state_event/2 is invoked.
+%% Returns: {next_state, NextStateName, NextStateData}          |
+%%          {next_state, NextStateName, NextStateData, Timeout} |
+%%          {stop, Reason, NewStateData}
+%%----------------------------------------------------------------------
+handle_event(close, _StateName, S) ->
+    gen_tcp:close(S#eldap.fd),
+    {stop, closed, S};
+
+handle_event(_Event, StateName, S) ->
+    {next_state, StateName, S}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_sync_event/4
+%% Called when gen_fsm:sync_send_all_state_event/2,3 is invoked
+%% Returns: {next_state, NextStateName, NextStateData}            |
+%%          {next_state, NextStateName, NextStateData, Timeout}   |
+%%          {reply, Reply, NextStateName, NextStateData}          |
+%%          {reply, Reply, NextStateName, NextStateData, Timeout} |
+%%          {stop, Reason, NewStateData}                          |
+%%          {stop, Reason, Reply, NewStateData}
+%%----------------------------------------------------------------------
+handle_sync_event({debug_level, N}, _From, StateName, S) ->
+    {reply, ok, StateName, S#eldap{debug_level = N}};
+
+handle_sync_event(_Event, _From, StateName, S) ->
+    {reply, {StateName, S}, StateName, S}.
+
+%% handle_sync_event(_Event, _From, StateName, S) ->
+%%     Reply = ok,
+%%     {reply, Reply, StateName, S}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/3
+%% Returns: {next_state, NextStateName, NextStateData}          |
+%%          {next_state, NextStateName, NextStateData, Timeout} |
+%%          {stop, Reason, NewStateData}
+%%----------------------------------------------------------------------
+
+%%
+%% Packets arriving in various states
+%%
+handle_info({tcp, _Socket, Data}, connecting, S) ->
+    log1("eldap. tcp packet received when disconnected!~n~p~n", [Data], S),
+    {next_state, connecting, S};
+
+handle_info({tcp, _Socket, Data}, wait_bind_response, S) ->
+    cancel_timer(S#eldap.bind_timer),
+    case catch recvd_wait_bind_response(Data, S) of
+	bound                -> {next_state, active, S};
+	{fail_bind, _Reason}  -> close_and_retry(S),
+				{next_state, connecting, S#eldap{fd = null}};
+	{'EXIT', _Reason}     -> close_and_retry(S),
+				{next_state, connecting, S#eldap{fd = null}};
+	{error, _Reason}      -> close_and_retry(S),
+				{next_state, connecting, S#eldap{fd = null}}
+    end;
+
+handle_info({tcp, _Socket, Data}, active, S) ->
+    case catch recvd_packet(Data, S) of
+	{reply, Reply, To, NewS} -> gen_fsm:reply(To, Reply),
+				    {next_state, active, NewS};
+	{ok, NewS}               -> {next_state, active, NewS};
+	{'EXIT', _Reason}         -> {next_state, active, S};
+	{error, _Reason}          -> {next_state, active, S}
+    end;
+
+handle_info({tcp_closed, _Socket}, _All_fsm_states, S) ->
+    F = fun(_Id, [{Timer, From, _Name}|_Res]) ->
+		gen_fsm:reply(From, {error, tcp_closed}),
+		cancel_timer(Timer)
+	end,
+    dict:map(F, S#eldap.dict),
+    retry_connect(),
+    {next_state, connecting, S#eldap{fd = null,
+				     dict = dict:new()}};
+
+handle_info({tcp_error, _Socket, Reason}, Fsm_state, S) ->
+    log1("eldap received tcp_error: ~p~nIn State: ~p~n", [Reason, Fsm_state], S),
+    {next_state, Fsm_state, S};
+%%
+%% Timers
+%%
+handle_info({timeout, Timer, {cmd_timeout, Id}}, active, S) ->
+    case cmd_timeout(Timer, Id, S) of
+	{reply, To, Reason, NewS} -> gen_fsm:reply(To, Reason),
+				     {next_state, active, NewS};
+	{error, _Reason}           -> {next_state, active, S}
+    end;
+
+handle_info({timeout, retry_connect}, connecting, S) ->
+    {ok, NextState, NewS} = connect_bind(S),
+    {next_state, NextState, NewS};
+
+handle_info({timeout, _Timer, bind_timeout}, wait_bind_response, S) ->
+    close_and_retry(S),
+    {next_state, connecting, S#eldap{fd = null}};
+
+%%
+%% Make sure we don't fill the message queue with rubbish
+%%
+handle_info(Info, StateName, S) ->
+    log1("eldap. Unexpected Info: ~p~nIn state: ~p~n when StateData is: ~p~n",
+			[Info, StateName, S], S),
+    {next_state, StateName, S}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/3
+%% Purpose: Shutdown the fsm
+%% Returns: any
+%%----------------------------------------------------------------------
+terminate(_Reason, _StateName, _StatData) ->
+    ok.
+
+%%----------------------------------------------------------------------
+%% Func: code_change/4
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState, NewStateData}
+%%----------------------------------------------------------------------
+code_change(_OldVsn, StateName, S, _Extra) ->
+    {ok, StateName, S}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+send_command(Command, From, S) ->
+    Id = bump_id(S),
+    {Name, Request} = gen_req(Command),
+    Message = #'LDAPMessage'{messageID  = Id,
+			     protocolOp = {Name, Request}},
+    log2("~p~n",[{Name, Request}], S),
+    {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+    ok = gen_tcp:send(S#eldap.fd, Bytes),
+    Timer = erlang:start_timer(?CMD_TIMEOUT, self(), {cmd_timeout, Id}),
+    New_dict = dict:store(Id, [{Timer, From, Name}], S#eldap.dict),
+    {ok, S#eldap{id = Id,
+		 dict = New_dict}}.
+
+gen_req({search, A}) ->
+    {searchRequest,
+     #'SearchRequest'{baseObject   = A#eldap_search.base,
+		      scope        = v_scope(A#eldap_search.scope),
+		      derefAliases = neverDerefAliases,
+		      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)
+		     }};
+gen_req({add, Entry, Attrs}) ->
+    {addRequest,
+     #'AddRequest'{entry      = Entry,
+		   attributes = Attrs}};
+gen_req({delete, Entry}) ->
+    {delRequest, Entry};
+gen_req({modify, Obj, Mod}) ->
+    v_modifications(Mod),
+    {modifyRequest,
+     #'ModifyRequest'{object       = Obj,
+		      changes = Mod}};
+gen_req({modify_dn, Entry, NewRDN, DelOldRDN, NewSup}) ->
+    {modDNRequest,
+     #'ModifyDNRequest'{entry        = Entry,
+			newrdn       = NewRDN,
+			deleteoldrdn = DelOldRDN,
+			newSuperior  = NewSup}}.
+
+%%-----------------------------------------------------------------------
+%% recvd_packet
+%% Deals with incoming packets in the active state
+%% Will return one of:
+%%  {ok, NewS} - Don't reply to client yet as this is part of a search
+%%               result and we haven't got all the answers yet.
+%%  {reply, Result, From, NewS} - Reply with result to client From
+%%  {error, Reason}
+%%  {'EXIT', Reason} - Broke
+%%-----------------------------------------------------------------------
+recvd_packet(Pkt, S) ->
+    check_tag(Pkt),
+    case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of
+	{ok,Msg} ->
+	    Op = Msg#'LDAPMessage'.protocolOp,
+	    log2("~p~n",[Op], S),
+	    Dict = S#eldap.dict,
+	    Id = Msg#'LDAPMessage'.messageID,
+	    {Timer, From, Name, Result_so_far} = get_op_rec(Id, Dict),
+	    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}} ->
+		    case Result#'LDAPResult'.resultCode of
+			success ->
+			    {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}};
+			Reason ->
+			    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}};
+		{OtherName, OtherResult} ->
+		    New_dict = dict:erase(Id, Dict),
+		    cancel_timer(Timer),
+		    {reply, {error, {invalid_result, OtherName, OtherResult}},
+		            From, S#eldap{dict = New_dict}}
+	    end;
+	Error -> Error
+    end.
+
+check_reply(#'LDAPResult'{resultCode = success}, _From) ->
+    ok;
+check_reply(#'LDAPResult'{resultCode = Reason}, _From) ->
+    {error, Reason};
+check_reply(Other, _From) ->
+    {error, Other}.
+
+get_op_rec(Id, Dict) ->
+    case dict:find(Id, Dict) of
+	{ok, [{Timer, From, Name}|Res]} ->
+	    {Timer, From, Name, Res};
+	error ->
+	    throw({error, unkown_id})
+    end.
+
+%%-----------------------------------------------------------------------
+%% recvd_wait_bind_response packet
+%% Deals with incoming packets in the wait_bind_response state
+%% Will return one of:
+%%  bound - Success - move to active state
+%%  {fail_bind, Reason} - Failed
+%%  {error, Reason}
+%%  {'EXIT', Reason} - Broken packet
+%%-----------------------------------------------------------------------
+recvd_wait_bind_response(Pkt, S) ->
+    check_tag(Pkt),
+    case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of
+	{ok,Msg} ->
+	    log2("~p", [Msg], S),
+	    check_id(S#eldap.id, Msg#'LDAPMessage'.messageID),
+	    case Msg#'LDAPMessage'.protocolOp of
+		{bindResponse, Result} ->
+		    case Result#'LDAPResult'.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}).
+
+%%-----------------------------------------------------------------------
+%% General Helpers
+%%-----------------------------------------------------------------------
+
+cancel_timer(Timer) ->
+    erlang:cancel_timer(Timer),
+    receive
+	{timeout, Timer, _} ->
+	    ok
+    after 0 ->
+	    ok
+    end.
+
+
+%%% Sanity check of received packet
+check_tag(Data) ->
+    case asn1rt_ber:decode_tag(Data) of
+	{_Tag, Data1, _Rb} ->
+	    case asn1rt_ber:decode_length(Data1) of
+		{{_Len,_Data2}, _Rb2} -> ok;
+		_ -> throw({error,decoded_tag_length})
+	    end;
+	_ -> throw({error,decoded_tag})
+    end.
+
+close_and_retry(S) ->
+    gen_tcp:close(S#eldap.fd),
+    retry_connect().
+
+retry_connect() ->
+    erlang:send_after(?RETRY_TIMEOUT, self(),
+		      {timeout, retry_connect}).
+
+
+%%-----------------------------------------------------------------------
+%% Sort out timed out commands
+%%-----------------------------------------------------------------------
+cmd_timeout(Timer, Id, S) ->
+    Dict = S#eldap.dict,
+    case dict:find(Id, Dict) of
+	{ok, [{Id, Timer, 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}};
+		_Others ->
+		    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.
+
+%%-----------------------------------------------------------------------
+%% Common stuff for results
+%%-----------------------------------------------------------------------
+%%%
+%%% Polish the returned search result
+%%%
+
+polish(Entries) ->
+    polish(Entries, [], []).
+
+polish([H|T], Res, Ref) when is_record(H, 'SearchResultEntry') ->
+    ObjectName = H#'SearchResultEntry'.objectName,
+    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}.
+
+%%-----------------------------------------------------------------------
+%% Connect to next server in list and attempt to bind to it.
+%%-----------------------------------------------------------------------
+connect_bind(S) ->
+    Host = next_host(S#eldap.host, S#eldap.hosts),
+    TcpOpts = [{packet, asn1}, {active, true}],
+    case gen_tcp:connect(Host, S#eldap.port, TcpOpts) of
+	{ok, Socket} ->
+	    case bind_request(Socket, S) of
+		{ok, NewS} ->
+		    Timer = erlang:start_timer(?BIND_TIMEOUT, self(),
+					       {timeout, bind_timeout}),
+		    {ok, wait_bind_response, NewS#eldap{fd = Socket,
+							host = Host,
+							bind_timer = Timer}};
+		{error, _Reason} ->
+		    gen_tcp:close(Socket),
+		    erlang:send_after(?RETRY_TIMEOUT, self(),
+				      {timeout, retry_connect}),
+		    {ok, connecting, S#eldap{host = Host}}
+	    end;
+	{error, _Reason} ->
+	    erlang:send_after(?RETRY_TIMEOUT, self(),
+			      {timeout, retry_connect}),
+	    {ok, connecting, S#eldap{host = Host}}
+    end.
+
+bind_request(Socket, S) ->
+    Id = bump_id(S),
+    Req = #'BindRequest'{version        = S#eldap.version,
+			 name           = S#eldap.rootdn,
+			 authentication = {simple, S#eldap.passwd}},
+    Message = #'LDAPMessage'{messageID  = Id,
+			     protocolOp = {bindRequest, Req}},
+    log2("Message:~p~n",[Message], S),
+    {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+    ok = gen_tcp:send(Socket, Bytes),
+    {ok, S#eldap{id = Id}}.
+
+%% 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(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, [_H|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(_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|_T]) ->
+    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, Log} ->
+		    {ok, Hosts, Port, Rootdn, Passwd, Log};
+		{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_log(log, 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_log(Key, List) ->
+    case lists:keysearch(Key, 1, List) of
+	{value, {Key, Value}} when is_function(Value) ->
+	    Value;
+	{value, {Key, _Else}} ->
+	    false;
+	false ->
+	    fun(_Level, Format, Args) -> io:format("--- " ++ Format, Args) end
+    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 ->
+    ?MIN_TRANSACTION_ID;
+bump_id(#eldap{id = Id}) ->
+    Id + 1.
+
+%%% --------------------------------------------------------------------
+%%% Log routines. Call a user provided log routine Fun.
+%%% --------------------------------------------------------------------
+
+log1(Str, Args, #eldap{log = Fun, debug_level = N}) -> log(Fun, Str, Args, 1, N).
+log2(Str, Args, #eldap{log = Fun, debug_level = N}) -> log(Fun, Str, Args, 2, N).
+
+log(Fun, Str, Args, This_level, Status) when is_function(Fun), This_level =< Status ->
+    catch Fun(This_level, Str, Args);
+log(_, _, _, _, _) ->
+    ok.
diff --git a/lib/eldap/src/eldap_sup.erl b/lib/eldap/src/eldap_sup.erl
new file mode 100644
index 0000000000..1a93bd15b7
--- /dev/null
+++ b/lib/eldap/src/eldap_sup.erl
@@ -0,0 +1,28 @@
+
+-module(eldap_sup).
+
+-behaviour(supervisor).
+
+%% API
+-export([start_link/0]).
+
+%% Supervisor callbacks
+-export([init/1]).
+
+%% Helper macro for declaring children of supervisor
+-define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}).
+
+%% ===================================================================
+%% API functions
+%% ===================================================================
+
+start_link() ->
+    supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+%% ===================================================================
+%% Supervisor callbacks
+%% ===================================================================
+
+init([]) ->
+    {ok, { {one_for_one, 5, 10}, []} }.
+