Permalink
Browse files

- add ldap plugin (Pablo Polvorin) (TSUN-56)

- import eldap source in src/lib

SVN Revision: 833
  • Loading branch information...
1 parent a00eb52 commit 0247d6334b2b13b4c12b2c7c07e7e9885dfbb773 @nniclausse nniclausse committed Apr 11, 2008
Showing with 4,797 additions and 0 deletions.
  1. +3,011 −0 src/lib/ELDAPv3.erl
  2. +1,082 −0 src/lib/eldap.erl
  3. +125 −0 src/lib/rfc4515_parser.erl
  4. +265 −0 src/tsung/ts_ldap.erl
  5. +163 −0 src/tsung/ts_ldap_common.erl
  6. +151 −0 src/tsung_controller/ts_config_ldap.erl
View
3,011 src/lib/ELDAPv3.erl
3,011 additions, 0 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
View
1,082 src/lib/eldap.erl
@@ -0,0 +1,1082 @@
+-module(eldap).
+%%% --------------------------------------------------------------------
+%%% Created: 12 Oct 2000 by Tobbe <tnt@home.se>
+%%% 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
+%%% --------------------------------------------------------------------
+-vc('$Id: eldap.erl,v 1.5 2006/11/24 09:38:11 etnt Exp $ ').
+-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 list(Hosts), list(Opts) ->
+ Self = self(),
+ Pid = spawn_link(fun() -> init(Hosts, Opts, Self) end),
+ recv(Pid).
+
+%%% --------------------------------------------------------------------
+%%% Shutdown connection (and process) asynchronous.
+%%% --------------------------------------------------------------------
+
+close(Handle) when pid(Handle) ->
+ send(Handle, close).
+
+%%% --------------------------------------------------------------------
+%%% Set who we should link ourselves to
+%%% --------------------------------------------------------------------
+
+controlling_process(Handle, Pid) when pid(Handle),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 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 pid(Handle),list(Entry),list(Attributes) ->
+ send(Handle, {add, Entry, add_attrs(Attributes)}),
+ recv(Handle).
+
+%%% Do sanity check !
+add_attrs(Attrs) ->
+ F = fun({Type,Vals}) when list(Type),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 pid(Handle), 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 pid(Handle), list(Object), list(Mods) ->
+ send(Handle, {modify, Object, Mods}),
+ recv(Handle).
+
+%%%
+%%% Modification operations.
+%%% Example:
+%%% replace("telephoneNumber", ["555 555 00"])
+%%%
+mod_add(Type, Values) when list(Type), list(Values) -> m(add, Type, Values).
+mod_delete(Type, Values) when list(Type), list(Values) -> m(delete, Type, Values).
+mod_replace(Type, Values) when list(Type), list(Values) -> m(replace, Type, Values).
+
+m(Operation, Type, Values) ->
+ #'ModifyRequest_modification_SEQOF'{
+ operation = Operation,
+ modification = #'AttributeTypeAndValues'{
+ 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 pid(Handle),list(Entry),list(NewRDN),atom(DelOldRDN),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 pid(Handle), record(A, eldap_search) ->
+ call_search(Handle, A);
+search(Handle, L) when pid(Handle), list(L) ->
+ case catch parse_search_args(L) of
+ {error, Emsg} -> {error, Emsg};
+ A when 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 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 list(ListOfFilters) -> {'and',ListOfFilters}.
+'or'(ListOfFilters) when list(ListOfFilters) -> {'or', ListOfFilters}.
+'not'(Filter) when 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 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 list(Type), 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 integer(Port) ->
+ parse_args(T, Cpid, Data#eldap{port = Port});
+parse_args([{timeout, Timeout}|T], Cpid, Data) when 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 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 ->
+ Vsn = erlang:system_info(version),
+ if Vsn >= "5.3" ->
+ %% In R9C, but not in R9B
+ {_,_,X} = erlang:now(),
+ ssl:seed("bkrlnateqqo" ++ integer_to_list(X));
+ true -> true
+ end,
+ 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 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 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 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,
+ modification = 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 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 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 integer(I), I>=0 -> I;
+v_timeout(_I) -> throw({error,concat(["timeout not positive integer: ",_I])}).
+
+v_attributes(Attrs) ->
+ F = fun(A) when 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 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,[]} ->
+ 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) ->
+ 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,_) ->
+ 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) -> 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)}.
+
+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 integer(Port) -> Port;
+ _ -> error(parsing_port,Rest)
+ end.
+
+parse_host(Rest,Shost) ->
+ case catch validate_host(Shost) of
+ {parse_error,Emsg,_} -> 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;
+ _ -> 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 binary(B) -> B;
+b2l(L) when list(L) -> list_to_binary(L).
+
View
125 src/lib/rfc4515_parser.erl
@@ -0,0 +1,125 @@
+%% Parsing functions for RFC4515 (String Representation of LDAP Search Filters)
+%%
+%% TODO: extensibleMatch features not implemented.
+%%
+%% Author : Pablo Polvorin <ppolv@yahoo.com.ar>
+-module(rfc4515_parser).
+-author('ppolv@yahoo.com.ar').
+
+
+-export([tokenize/1,filter/1,filter_to_string/1]).
+
+
+
+%% tokenize/1
+%% Tokenize the input string into a token list. Generated tokens:
+%% '(' , ')' , '=' , '<=' ,'>=' , '~=' , '*' , '&' , '|' , '*' , {text,Value}
+%% Ej:
+%% ldap_parser:tokenize("(&(!(prpr=a*s*sse*y))(pr~=sss))").
+%% --> ['(', '&','(', '!', '(', {text,"prpr"}, '=', {text,"a"}, '*', {text,"s"}, '*',
+%% {text,"sse"},'*', {text,"y"}, ')', ')', '(', {text,"pr"}, '~=', {text,"sss"}, ')', ')']
+%%
+tokenize(L) -> tokenizer(lists:flatten(L),[],[]). %%flatten because &amp; ,etc. in xml attributes ends in deep lists ej:[[38]]
+
+
+tokenizer([$(|L],Current,Tokens) -> tokenizer(L,[],['('|add_current(Current,Tokens)]);
+tokenizer([$)|L],Current,Tokens) -> tokenizer(L,[],[')'|add_current(Current,Tokens)]);
+tokenizer([$&|L],Current,Tokens) -> tokenizer(L,[],['&'|add_current(Current,Tokens)]);
+tokenizer([$||L],Current,Tokens) -> tokenizer(L,[],['|'|add_current(Current,Tokens)]);
+tokenizer([$!|L],Current,Tokens) -> tokenizer(L,[],['!'|add_current(Current,Tokens)]);
+tokenizer([$=|L],Current,Tokens) -> tokenizer(L,[],['='|add_current(Current,Tokens)]);
+tokenizer([$*|L],Current,Tokens) -> tokenizer(L,[],['*'|add_current(Current,Tokens)]);
+tokenizer([$>,$=|L],Current,Tokens) -> tokenizer(L,[],['>='|add_current(Current,Tokens)]);
+tokenizer([$<,$=|L],Current,Tokens) -> tokenizer(L,[],['<='|add_current(Current,Tokens)]);
+tokenizer([$~,$=|L],Current,Tokens) -> tokenizer(L,[],['~='|add_current(Current,Tokens)]);
+
+%% an encoded valued start with a backslash '\' character followed by the
+%%two hexadecimal digits representing the ASCII value of the encoded character
+tokenizer([92|L],Current,Tokens) -> [H1,H2|L2] = L,
+ tokenizer(L2,[decode([H1,H2])|Current],Tokens);
+tokenizer([C|L],Current,Tokens) -> tokenizer(L,[C|Current],Tokens);
+tokenizer([],[],Tokens) -> lists:reverse(Tokens). %%FIXME: accept trailing whitespaces
+
+add_current(Current,Tokens) ->
+ case string:strip(Current) of
+ [] -> Tokens ;
+ X -> [{text,lists:reverse(X)}|Tokens]
+ end.
+
+
+decode(Hex) ->
+ {ok,[C],[]} = io_lib:fread("~#","16#" ++ Hex),
+ C.
+
+%% filter/1
+%% parse a token list into an AST-like structure.
+%% Ej:
+%% ldap_parser:filter(ldap_parser:tokenize("(&(!(prpr=a*s*sse*y))(pr~=sss))")).
+%% --> {{'and',[{'not',{substring,"prpr",
+%% [{initial,"a"},
+%% {any,"s"},
+%% {any,"sse"},
+%% {final,"y"}]}},
+%% {aprox,"pr","sss"}]},
+%% []}
+filter(['('|L]) -> {R, [')'|L2]} =filtercomp(L),
+ {R,L2}.
+
+filtercomp(['&'|L]) -> {R,L2} = filterlist(L),
+ {{'and',R},L2};
+filtercomp(['|'|L]) -> {R,L2} = filterlist(L),
+ {{'or',R},L2};
+filtercomp(['!'|L]) -> {R,L2} = filter(L),
+ {{'not',R},L2};
+filtercomp(L) -> item(L).
+
+
+filterlist(L) -> filterlist(L,[]).
+
+filterlist(L=[')'|_],List) -> {lists:reverse(List),L}; %% ')' marks the end of the filter list
+filterlist(L,List) -> {R,L2} = filter(L),
+ filterlist(L2,[R|List]).
+
+item([{text,T}|L]) -> item2(L,T).
+
+item2(['~=',{text,V}|L],Attr) -> {{aprox,Attr,V},L};
+item2(['>=',{text,V}|L],Attr) -> {{get,Attr,V},L};
+item2(['<=',{text,V}|L],Attr) -> {{'let',Attr,V},L};
+item2(['='|L],Attr) -> item3(L,Attr). % could be a presence, equality or substring match
+
+
+item3(L = [')'|_],Attr) -> {{eq,Attr,""},L}; %empty attr ej: (description=)
+item3(['*',')'|L],Attr) -> {{present,Attr},[')'|L]}; %presence ej: (description=*)
+item3([{text,V},')'|L],Attr) -> {{eq,Attr,V},[')'|L]}; %eq ej : = (description=some description)
+item3(L,Attr) -> {R,L2} = substring(L),
+ {{substring,Attr,R},L2}.
+
+substring([{text,V},'*'|L]) -> any(L,[{initial,V}]);
+substring(['*'|L]) -> any(L,[]).
+
+any([{text,V},'*'|L],Subs) -> any(L,[{'any',V}|Subs]);
+any([{text,V},')'|L],Subs) -> {lists:reverse([{final,V}|Subs]),[')'|L]};
+any(L = [')'|_],Subs) -> {lists:reverse(Subs),L}.
+
+
+
+
+
+
+
+filter_to_string({'and',L}) -> io_lib:format("(& ~s)",[lists:map(fun filter_to_string/1,L)]);
+filter_to_string({'or',L}) -> io_lib:format("(| ~s)",[lists:map(fun filter_to_string/1,L)]);
+filter_to_string({'not',I}) -> io_lib:format("(! ~s)",[filter_to_string(I)]);
+filter_to_string({'present',Attr}) -> io_lib:format("(~s=*)",[Attr]);
+filter_to_string({'substring',Attr,Subs}) -> io_lib:format("(~s=~s)",[Attr,print_substrings(Subs)]);
+filter_to_string({'aprox',Attr,Value}) -> io_lib:format("(~s~~=~s)",[Attr,Value]);
+filter_to_string({'let',Attr,Value}) -> io_lib:format("(~s<=~s)",[Attr,Value]);
+filter_to_string({'get',Attr,Value}) -> io_lib:format("(~s>=~s)",[Attr,Value]);
+filter_to_string({'eq',Attr,Value}) -> io_lib:format("(~s=~s)",[Attr,Value]).
+
+
+print_substrings(Subs) -> lists:map(fun print_substring/1,Subs).
+print_substring({initial,V}) -> io_lib:format("~s",[V]);
+print_substring({final,V}) -> io_lib:format("*~s",[V]);
+print_substring({any,V}) -> io_lib:format("*~s",[V]).
+
View
265 src/tsung/ts_ldap.erl
@@ -0,0 +1,265 @@
+%%% This program is free software; you can redistribute it and/or modify
+%%% it under the terms of the GNU General Public License as published by
+%%% the Free Software Foundation; either version 2 of the License, or
+%%% (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+%%% GNU General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%%%
+
+%%% In addition, as a special exception, you have the permission to
+%%% link the code of this program with any library released under
+%%% the EPL license and distribute linked combinations including
+%%% the two.
+
+%%% File : ts_ldap.erl
+%%% Author : Pablo Polvorin <ppolv@yahoo.com.ar>
+%%% Purpose : LDAP plugin
+
+
+-module(ts_ldap).
+
+-export([init_dynparams/0,
+ add_dynparams/4,
+ get_message/1,
+ session_defaults/0,
+ parse/2,
+ parse_config/2,
+ new_session/0
+ ]).
+
+-include("ts_profile.hrl").
+-include("ts_ldap.hrl").
+-include("ELDAPv3.hrl").
+
+%%----------------------------------------------------------------
+%%-----Configuration parsing
+%%----------------------------------------------------------------
+parse_config(Element, Conf) ->
+ ts_config_ldap:parse_config(Element,Conf).
+
+%%----------------------------------------------------------------------
+%% Function: session_default/0
+%% Purpose: default parameters for session
+%% Returns: {ok, persistent = true|false}
+%%----------------------------------------------------------------------
+session_defaults() ->
+ {ok, true}.
+
+%%----------------------------------------------------------------------
+%% Function: new_session/0
+%% Purpose: initialize session information
+%% Returns: record or []
+%%----------------------------------------------------------------------
+new_session() ->
+ ts_ldap_common:empty_packet_state().
+%%FIXME: this won't be necessary when the SSL module support the asn1
+%% packet type. At this moment we are parsing the packet by
+%% ourselves, even over plain gen_tcp sockets, which can
+%% recognize asn1...
+
+
+%%----------------------------------------------------------------------
+%% Function: parse/2
+%% Purpose: parse the response from the server and keep information
+%% about the response in State#state_rcv.session
+%% Args: Data (binary), State (#state_rcv)
+%% Returns: {NewState, Options for socket (list), Close = true|false}
+%%----------------------------------------------------------------------
+parse(closed, State) ->
+ {State#state_rcv{ack_done = true, datasize=0}, [], true};
+
+
+%% Shortcut, when using ssl i'm getting lots <<>> data. Also, next
+%% clause is an infinite loop if data is <<>>
+parse(<<>>,State) ->
+ {State,[],false};
+
+%% new response, compute data size (for stats)
+parse(Data, State=#state_rcv{acc = [], datasize= 0}) ->
+ parse(Data, State#state_rcv{datasize= size(Data)});
+
+parse(Data, State=#state_rcv{acc = [], dyndata=_DynData,session=Session,datasize=PrevSize}) ->
+ St = ts_ldap_common:push(Data,Session),
+ parse_packets(State#state_rcv{session=St,datasize =PrevSize + size(Data) },St).
+
+
+%% Can read more than one entire asn1 packet from the network. Read
+%% packets until either there are no more packets available in the
+%% buffer (ack_done=false), or the ack_done flag was set true by the
+%% appropiate parse_ldap_response
+parse_packets(State,Asn1St) ->
+ case ts_ldap_common:get_packet(Asn1St) of
+ {none,NewAsn1St} ->
+ {State#state_rcv{ack_done=false,session=NewAsn1St},[],false};
+ {packet,Packet,NewAsn1St} ->
+ {ok,Resp} = asn1rt:decode('ELDAPv3', 'LDAPMessage', Packet),
+ parse_packet(Resp,State#state_rcv{session = NewAsn1St})
+ end.
+
+parse_packet(Resp,State) ->
+ R = parse_ldap_response(Resp,State),
+ {St,_Opts,_Close} = R,
+ if
+ St#state_rcv.ack_done == true -> R;
+ St#state_rcv.ack_done == false -> parse_packets(St,St#state_rcv.session)
+ end.
+
+
+%%TODO: see if its useful to count how many response records we get for each search.
+parse_ldap_response( #'LDAPMessage'{protocolOp = {bindResponse,Result}},State)->
+ case Result#'BindResponse'.resultCode of
+ success ->
+ ?Debug("Bind successful~n"),
+ {State#state_rcv{ack_done=true},[],false};
+ _Error ->
+ ts_mon:add({ count, ldap_bind_error}), %FIXME: retry,fail,etc. should be configurable
+ ?LOG("Bind fail~n",?INFO),
+ {State#state_rcv{ack_done=true},[],true}
+ end;
+
+parse_ldap_response( #'LDAPMessage'{protocolOp = {'searchResDone',R}},State) ->
+ ?DebugF("LDAP Search response Done ~p~n",[R]),
+ {State#state_rcv{ack_done=true},[],false}; %%Response done, mark as acknowledged
+parse_ldap_response( #'LDAPMessage'{protocolOp = {'searchResEntry',R}},State) ->
+ ?DebugF("LDAP search response Entry ~p~n",[R]),
+ {State#state_rcv{ack_done=false},[],false};
+parse_ldap_response(#'LDAPMessage'{protocolOp = {'searchResRef',R}},State) ->
+ ?DebugF("LDAP search response Ref ~p~n",[R]),
+ {State#state_rcv{ack_done=false},[],false};
+
+
+%% When get a possitive response to a startTLS command, inmediatly start ssl over that socket.
+parse_ldap_response(#'LDAPMessage'{protocolOp = {'extendedResp',ExtResponse }},State) ->
+ case ExtResponse#'ExtendedResponse'.resultCode of
+ success ->
+ #ts_request{param = LDAPRequest} = State#state_rcv.request,
+ %%Warnning: this won't work unless using a really recent OTP
+ {ok,Ssl_socket} = ssl:connect(State#state_rcv.socket,[{cacertfile,LDAPRequest#ldap_request.cacertfile},
+ {certfile,LDAPRequest#ldap_request.certfile},
+ {keyfile,LDAPRequest#ldap_request.keyfile}
+ ]),
+ {State#state_rcv{socket=Ssl_socket,protocol=ssl,ack_done=true},[],false};
+ _Error ->
+ ts_mon:add({ count, ldap_starttls_error}),
+ ?LOG("StartTLS fail",?INFO),
+ {State#state_rcv{ack_done=true},[],false}
+ end;
+
+
+parse_ldap_response(#'LDAPMessage'{protocolOp = {'addResponse',Result}},State) ->
+ case Result#'LDAPResult'.resultCode of
+ success ->
+ {State#state_rcv{ack_done=true},[],false};
+ _Error ->
+ ts_mon:add({ count, ldap_add_error}),
+ ?LOG("Add fail",?INFO),
+ {State#state_rcv{ack_done=true},[],true}
+ end;
+
+parse_ldap_response(#'LDAPMessage'{protocolOp = {'modifyResponse',Result}},State) ->
+ case Result#'LDAPResult'.resultCode of
+ success ->
+ {State#state_rcv{ack_done=true},[],false};
+ _Error ->
+ ts_mon:add({ count, ldap_modify_error}),
+ ?LOG("Modify fail",?INFO),
+ {State#state_rcv{ack_done=true},[],true}
+end;
+
+parse_ldap_response(Resp,State) ->
+ ?LOGF("Got unexpected response: ~p~n",[Resp],?INFO),
+ ts_mon:add({ count, ldap_unexpected_msg_resp}),
+ {State#state_rcv{ack_done=true},[],false}.
+
+
+%%----------------------------------------------------------------------
+%% Function: add_dynparams/4
+%% Purpose: add dynamic parameters to build the message
+%% Args: Subst (true|false), DynData = #dyndata, Param = #myproto_request
+%% Host = String
+%% Returns: #ldap_request
+%%
+%%----------------------------------------------------------------------
+add_dynparams(false, _DynData, Param, _HostData) ->
+ Param;
+
+%% Bind message. Substitution on user and password.
+add_dynparams(true, DynData, Param = #ldap_request{type=bind,user=User,password=Password}, _HostData) ->
+ Param#ldap_request{user=ts_search:subst(User,DynData#dyndata.dynvars),password=ts_search:subst(Password,DynData#dyndata.dynvars)};
+
+%% Search message. Only perfom substitutions on the filter of the search requests.
+%% The filter text was already parsed into a tree-like struct, substitution
+%% is perfomed in the "leaf" of this tree.
+add_dynparams(true, DynData, Param = #ldap_request{type=search, filter = Filter}, _HostData) ->
+ Param#ldap_request{filter = subs_filter(Filter,DynData#dyndata.dynvars)};
+
+
+%% Add message. Substitution on DN and attrs values.
+add_dynparams(true,DynData,Param = #ldap_request{type=add,dn=DN,attrs=Attrs},_HostData) ->
+ Param#ldap_request{dn=ts_search:subst(DN,DynData#dyndata.dynvars), attrs=subs_attrs(Attrs,DynData#dyndata.dynvars)};
+
+%% Modification message. Substitution on DN and attrs values.
+add_dynparams(true,DynData,Param = #ldap_request{type=modify,dn=DN,modifications=Modifications},_HostData) ->
+ SubsModifications = [{Operation,AttrType,[ts_search:subst(Value,DynData#dyndata.dynvars) || Value <- Values]} || {Operation,AttrType,Values}<- Modifications ],
+ Param#ldap_request{dn=ts_search:subst(DN,DynData#dyndata.dynvars), attrs=SubsModifications}.
+
+subs_filter({Rel,Filters},DynVars) when (Rel == 'and') or (Rel == 'or') ->
+ {Rel,lists:map(fun(F)-> subs_filter(F,DynVars) end,Filters)};
+
+subs_filter({'not',Filter},DynVars) ->
+ {'not',subs_filter(Filter,DynVars)};
+
+subs_filter({BinRel,Attr,Val},DynVars) when (BinRel == 'aprox') or (BinRel == 'get') or (BinRel == 'let') or (BinRel=='eq')->
+ {BinRel,Attr,ts_search:subst(Val,DynVars)};
+
+subs_filter({substring,Attr,Substrings},DynVars) ->
+ {substring,Attr,lists:map(fun({Pos,Val}) -> {Pos,ts_search:subst(Val,DynVars)} end, Substrings)}.
+
+subs_attrs(Attrs,DynVars) ->
+ [{Attr,[ts_search:subst(Value,DynVars) || Value <- Values]} || {Attr,Values}<-Attrs ].
+
+%%----------------------------------------------------------------------
+%% Function: init_dynparams/0
+%% Purpose: initial dynamic parameters value
+%% Returns: #dyndata
+%%----------------------------------------------------------------------
+init_dynparams() ->
+ #dyndata{proto=none}.
+
+
+%%----------------------------------------------------------------
+%%-----Messages
+%%----------------------------------------------------------------
+
+get_message(#ldap_request{type=bind,user=User,password=Password}) ->
+ X = ts_ldap_common:bind_msg(ts_msg_server:get_id(),User,Password),
+ iolist_to_binary(X);
+%% TODO: we really need to consult the central msg_server to find a session-specific id?, any reason to prevent
+%% the same id to be used in different sessions?
+
+get_message(#ldap_request{type=search,base=Base,scope=Scope,filter=Filter,attributes=Attributes}) ->
+ EncodedFilter = ts_ldap_common:encode_filter(Filter),
+ X = ts_ldap_common:search_msg(ts_msg_server:get_id(),Base,Scope,EncodedFilter,Attributes),
+ iolist_to_binary(X);
+
+get_message(#ldap_request{type=start_tls}) ->
+ X = ts_ldap_common:start_tls_msg(ts_msg_server:get_id()),
+ iolist_to_binary(X);
+
+get_message(#ldap_request{type=unbind}) ->
+ iolist_to_binary(ts_ldap_common:unbind_msg(ts_msg_server:get_id()));
+
+get_message(#ldap_request{type=add,dn=DN,attrs=Attrs}) ->
+ iolist_to_binary(ts_ldap_common:add_msg(ts_msg_server:get_id(),DN,Attrs));
+
+
+get_message(#ldap_request{type=modify,dn=DN,modifications=Modifications}) ->
+ iolist_to_binary(ts_ldap_common:modify_msg(ts_msg_server:get_id(),DN,Modifications)).
+
View
163 src/tsung/ts_ldap_common.erl
@@ -0,0 +1,163 @@
+%%% This program is free software; you can redistribute it and/or modify
+%%% it under the terms of the GNU General Public License as published by
+%%% the Free Software Foundation; either version 2 of the License, or
+%%% (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+%%% GNU General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%%%
+
+%%% In addition, as a special exception, you have the permission to
+%%% link the code of this program with any library released under
+%%% the EPL license and distribute linked combinations including
+%%% the two.
+
+%%% File : ts_ldap_common.erl
+%%% Author : Pablo Polvorin <ppolv@yahoo.com.ar>
+%%% Purpose : LDAP plugin
+
+-module(ts_ldap_common).
+
+-export([encode_filter/1,
+ bind_msg/3,
+ unbind_msg/1,
+ search_msg/5,
+ start_tls_msg/1,
+ add_msg/3,
+ modify_msg/3 ]).
+
+-export([push/2,get_packet/1,empty_packet_state/0]).
+
+-define(LDAP_VERSION, 3).
+-define(START_TLS_OID,"1.3.6.1.4.1.1466.20037").
+
+-define(MAX_HEADER, 8). %% mm...
+
+-include("ELDAPv3.hrl").
+
+encode_filter({'and',L}) -> {'and',lists:map(fun encode_filter/1,L)};
+encode_filter({'or',L}) -> {'or',lists:map(fun encode_filter/1,L)};
+encode_filter({'not',I}) -> {'not',encode_filter(I)};
+encode_filter(I = {'present',_}) -> I;
+encode_filter({'substring',Attr,Subs}) -> eldap:substrings(Attr,Subs);
+encode_filter({eq,Attr,Value}) -> eldap:equalityMatch(Attr,Value);
+encode_filter({'let',Attr,Value}) -> eldap:lessOrEqual(Attr,Value);
+encode_filter({get,Attr,Value}) -> eldap:greaterOrEqual(Attr,Value);
+encode_filter({aproxq,Attr,Value}) -> eldap:approxMatch(Attr,Value).
+
+bind_msg(Id,User,Password) ->
+ Req = {bindRequest,#'BindRequest'{version=?LDAP_VERSION, name=User, authentication = {simple, Password}}},
+ Message = #'LDAPMessage'{messageID = Id,
+ protocolOp = Req},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+search_msg(Id,Base,Scope,Filter,Attributes) ->
+ Req = #'SearchRequest'{baseObject = Base,
+ scope = Scope,
+ derefAliases = neverDerefAliases,
+ sizeLimit = 0, % no size limit
+ timeLimit = 0,
+ typesOnly = false,
+ filter = Filter,
+ attributes = Attributes},
+ Message = #'LDAPMessage'{messageID = Id,
+ protocolOp = {searchRequest,Req}},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+
+start_tls_msg(Id) ->
+ Req = #'ExtendedRequest'{requestName = ?START_TLS_OID},
+ Message = #'LDAPMessage'{messageID = Id, protocolOp = {extendedReq,Req}},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+unbind_msg(Id) ->
+ Message = #'LDAPMessage'{messageID = Id,
+ protocolOp = {unbindRequest,[]}},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+add_msg(Id,DN,Attrs) ->
+ Req = #'AddRequest'{entry = DN,
+ attributes = [ {'AddRequest_attributes',Type, Values} || {Type,Values} <- Attrs]},
+ Message = #'LDAPMessage'{messageID = Id,
+ protocolOp = {addRequest,Req}},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+modify_msg(Id,DN,Modifications) ->
+ Mods = [ #'ModifyRequest_modification_SEQOF'{
+ operation = Operation,
+ modification = #'AttributeTypeAndValues'{type=Type,vals=Values}}
+ || {Operation,Type,Values} <- Modifications],
+ Req = #'ModifyRequest'{object = DN, modification = Mods},
+ Message = #'LDAPMessage'{messageID = Id, protocolOp = {modifyRequest,Req}},
+ {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message),
+ Bytes.
+
+
+
+%% -------------------------------------------
+%% asn1 packet buffering and delimiting
+%%
+%% Temporary fix until the new ssl module incorporate appropiate
+%% support for asn1 packets.
+%% -------------------------------------------
+
+-record(asn1_packet_state,
+ {
+ length = undefined,
+ buffer = <<>>
+ }).
+
+
+empty_packet_state() -> #asn1_packet_state{}.
+
+push(<<>>,S) ->
+ S;
+
+push(Data,S =#asn1_packet_state{buffer = B}) ->
+ S#asn1_packet_state{buffer = <<B/binary,Data/binary>>}.
+
+
+get_packet(S = #asn1_packet_state{buffer= <<>>}) ->
+ {none,S};
+
+get_packet(S = #asn1_packet_state{length=undefined,buffer=Buffer}) ->
+ case packet_length(Buffer) of
+ {ok,Length} -> extract_packet(S#asn1_packet_state{length=Length});
+ not_enough_data -> {none,S}
+ end;
+
+get_packet(S) -> extract_packet(S).
+
+
+extract_packet(#asn1_packet_state{length=N,buffer=Buffer}) when (size(Buffer) >= N) ->
+ <<Packet:N/binary,Rest/binary>> = Buffer,
+ {packet,Packet,#asn1_packet_state{length=undefined,buffer=Rest}};
+
+extract_packet(S) when is_record(S,asn1_packet_state) -> {none,S}.
+
+packet_length(Buffer) ->
+ try asn1rt_ber_bin:decode_tag_and_length(Buffer) of
+ {_Tag, Len,_Rest,RemovedBytes} -> {ok,Len+RemovedBytes}
+ catch
+ _Type:_Error ->
+ case size(Buffer) > ?MAX_HEADER of
+ true -> throw({invalid_packet,Buffer});
+ false -> not_enough_data
+ end
+ end.
View
151 src/tsung_controller/ts_config_ldap.erl
@@ -0,0 +1,151 @@
+%%% This program is free software; you can redistribute it and/or modify
+%%% it under the terms of the GNU General Public License as published by
+%%% the Free Software Foundation; either version 2 of the License, or
+%%% (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+%%% GNU General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+%%%
+
+%%% In addition, as a special exception, you have the permission to
+%%% link the code of this program with any library released under
+%%% the EPL license and distribute linked combinations including
+%%% the two.
+
+%%% File : ts_ldap.erl
+%%% Author : Pablo Polvorin <ppolv@yahoo.com.ar>
+%%% Purpose : LDAP plugin
+
+-module(ts_config_ldap).
+
+-export([ parse_config/2 ]).
+
+-include("ts_profile.hrl").
+-include("ts_config.hrl").
+-include("xmerl.hrl").
+-include("ts_ldap.hrl").
+
+
+%%----------------------------------------------------------------
+%%-----Configuration parsing
+%%----------------------------------------------------------------
+parse_config(Element = #xmlElement{name=dyn_variable}, Conf = #config{}) ->
+ ts_config:parse(Element,Conf);
+
+parse_config(Element = #xmlElement{name=ldap},
+ Config=#config{curid = Id, session_tab = Tab,
+ sessions = [CurS | _], dynvar=DynVar,
+ subst = SubstFlag, match=MatchRegExp}) ->
+
+ Request = case ts_config:getAttr(atom, Element#xmlElement.attributes, type) of
+ start_tls ->
+ Cacert = ts_config:getAttr(string,Element#xmlElement.attributes,cacertfile),
+ KeyFile = ts_config:getAttr(string,Element#xmlElement.attributes,keyfile),
+ CertFile = ts_config:getAttr(string,Element#xmlElement.attributes,certfile),
+ #ts_request{ack = parse,
+ endpage = true,
+ dynvar_specs= DynVar,
+ subst = SubstFlag,
+ match= MatchRegExp,
+ param = #ldap_request{type=start_tls,cacertfile=Cacert,keyfile=KeyFile,certfile=CertFile}};
+
+ bind ->
+ User = ts_config:getAttr(string,Element#xmlElement.attributes,user),
+ Password = ts_config:getAttr(string,Element#xmlElement.attributes,password),
+ #ts_request{ack = parse,
+ endpage = true,
+ dynvar_specs = DynVar,
+ subst = SubstFlag,
+ match = MatchRegExp,
+ param = #ldap_request{type=bind,user=User,password=Password}};
+
+ unbind ->
+ #ts_request{ack = no_ack,
+ endpage = true,
+ dynvar_specs = DynVar,
+ subst = SubstFlag,
+ match = MatchRegExp,
+ param = #ldap_request{type=unbind}};
+ search ->
+ Base = ts_config:getAttr(string,Element#xmlElement.attributes,base),
+ Scope = ts_config:getAttr(atom,Element#xmlElement.attributes,scope),
+ Filter = ts_config:getAttr(string,Element#xmlElement.attributes,filter),
+ Attributes=[],
+ {ParsedFilter,[]} = rfc4515_parser:filter(rfc4515_parser:tokenize(Filter)),
+ #ts_request{ack = parse,
+ endpage = true,
+ dynvar_specs = DynVar,
+ subst = SubstFlag,
+ match = MatchRegExp,
+ param = #ldap_request{type=search,
+ base=Base,
+ scope=Scope,
+ filter=ParsedFilter,
+ attributes=Attributes}};
+ add ->
+ DN = ts_config:getAttr(string,Element#xmlElement.attributes,dn),
+ XMLAttrs = [El || El <- Element#xmlElement.content, is_record(El,xmlElement)],
+ Attrs = lists:map(fun(#xmlElement{name=attr,attributes=Attr,content=Content}) ->
+ Vals = lists:foldl(fun(#xmlElement{name=value,content=[#xmlText{value=Value}]},Values) ->
+ [binary_to_list(iolist_to_binary(Value))|Values]
+ end,[] ,[E || E=#xmlElement{name=value} <- Content]),
+ {ts_config:getAttr(string,Attr,type),Vals}
+ end, XMLAttrs),
+ #ts_request{ack = parse,
+ endpage = true,
+ dynvar_specs = DynVar,
+ subst = SubstFlag,
+ match = MatchRegExp,
+ param = #ldap_request{type=add,
+ dn=DN,
+ attrs=Attrs
+ }};
+ modify ->
+ DN = ts_config:getAttr(string,Element#xmlElement.attributes,dn),
+ Modifications = [{list_to_atom(ts_config:getAttr(string,Attrs,type)),parse_xml_attr_type_and_value(Content)} ||
+ #xmlElement{name=modification,attributes=Attrs,content=Content} <- Element#xmlElement.content],
+
+ ExpandedModifications = lists:foldl( fun({Operation,Attrs},L) ->
+ lists:foldl(fun({Type,Values},L2) ->
+ [{Operation,Type,Values}|L2]
+ end,L,Attrs)
+ end,[],Modifications),
+ #ts_request{ack = parse,
+ endpage = true,
+ dynvar_specs = DynVar,
+ subst = SubstFlag,
+ match = MatchRegExp,
+ param = #ldap_request{type=modify,
+ modifications = ExpandedModifications,
+ dn=DN
+ }}
+ end,
+
+ ts_config:mark_prev_req(Id-1, Tab, CurS),
+ ets:insert(Tab,{{CurS#session.id, Id}, Request }),
+ lists:foldl( fun(A,B)->ts_config:parse(A,B) end,
+ Config#config{dynvar=undefined},
+ Element#xmlElement.content);
+
+%% Parsing other elements
+parse_config(Element = #xmlElement{}, Conf = #config{}) ->
+ ts_config:parse(Element,Conf);
+%% Parsing non #xmlElement elements
+parse_config(_, Conf = #config{}) ->
+ Conf.
+
+parse_xml_attr_values(Elements) ->
+ [binary_to_list(iolist_to_binary(Value))
+ || #xmlElement{name=value,content=[#xmlText{value=Value}]} <- Elements].
+
+parse_xml_attr_type_and_value(Elements) ->
+ [ {ts_config:getAttr(string,Attr,type),parse_xml_attr_values(Content)}
+ || #xmlElement{name=attr,attributes=Attr,content=Content} <-Elements].
+
+

0 comments on commit 0247d63

Please sign in to comment.