* src/mod_vcard_ldap.erl: LDAP server pool support (thanks to Evgeniy

Khramtsov) (EJAB-175)
* src/eldap/Makefile.in: Likewise
* src/ejabberd_auth_ldap.erl: Likewise
* src/eldap_pool.erl: Likewise

* src/eldap/eldap_utils.erl: Implemented LDAP domain substitution (EJAB-177)

* src/eldap/eldap.erl: Implemented queue to avoid bind deadlock under
heavy load (thanks to Evgeniy Khramtsov)  (EJAB-176)
* src/eldap/eldap.hrl: Likewise

SVN Revision: 716

6 files changed, 165 insertions, 43 deletions

diff --git a/src/eldap/Makefile.in b/src/eldap/Makefile.in
index de7933831..f244fe1b5 100644
--- a/src/eldap/Makefile.in
+++ b/src/eldap/Makefile.in
@@ -14,7 +14,8 @@ OBJS   = \
 	$(OUTDIR)/eldap.beam \
 	$(OUTDIR)/ELDAPv3.beam \
 	$(OUTDIR)/eldap_filter.beam \
-	$(OUTDIR)/eldap_utils.beam
+	$(OUTDIR)/eldap_utils.beam \
+	$(OUTDIR)/eldap_pool.beam
 
 all:    $(OBJS)
 
diff --git a/src/eldap/Makefile.win32 b/src/eldap/Makefile.win32
index 04b0e24e8..1e4c503e6 100644
--- a/src/eldap/Makefile.win32
+++ b/src/eldap/Makefile.win32
@@ -7,11 +7,13 @@ EFLAGS = -I .. -pz ..
 OBJS = \
 	$(OUTDIR)\eldap.beam \
 	$(OUTDIR)\ELDAPv3.beam \
-	$(OUTDIR)\eldap_filter.beam
+	$(OUTDIR)\eldap_filter.beam \
+	$(OUTDIR)\eldap_utils.beam \
+	$(OUTDIR)\eldap_pool.beam
 
 ALL : $(OBJS)
 
-CLEAN :
+Clean :
 	-@erase ELDAPv3.asn1db
 	-@erase ELDAPv3.erl
 	-@erase ELDAPv3.hrl
@@ -29,3 +31,9 @@ $(OUTDIR)\ELDAPv3.beam : ELDAPv3.erl
 
 $(OUTDIR)\eldap_filter.beam : eldap_filter.erl
 	erlc -W $(EFLAGS) -o $(OUTDIR) eldap_filter.erl
+
+$(OUTDIR)\eldap_utils.beam : eldap_utils.erl
+	erlc -W $(EFLAGS) -o $(OUTDIR) eldap_utils.erl
+
+$(OUTDIR)\eldap_pool.beam : eldap_pool.erl
+	erlc -W $(EFLAGS) -o $(OUTDIR) eldap_pool.erl
diff --git a/src/eldap/eldap.erl b/src/eldap/eldap.erl
index 1bf64b2b4..95bf37060 100644
--- a/src/eldap/eldap.erl
+++ b/src/eldap/eldap.erl
@@ -5,7 +5,7 @@
 %%%           The interface is based on RFC 1823, and
 %%%           draft-ietf-asid-ldap-c-api-00.txt
 %%%
-%%% Copyright (C) 2000  Torbjörn Törnkvist, tnt@home.se
+%%% Copyright (C) 2000  Torbj�n T�nkvist, tnt@home.se
 %%% 
 %%% This program is free software; you can redistribute it and/or modify
 %%% it under the terms of the GNU General Public License as published by
@@ -32,6 +32,9 @@
 
 
 %%% Modified by Alexey Shchepin <alexey@sevcom.net>
+
+%%% Modified by Evgeniy Khramtsov <xram@jabber.ru>
+%%% Implemented queue for bind() requests to prevent pending binds.
 %%% --------------------------------------------------------------------
 -vc('$Id$ ').
 
@@ -42,6 +45,7 @@
 %%%     connecting - actually disconnected, but retrying periodically
 %%%     wait_bind_response  - connected and sent bind request
 %%%     active - bound to LDAP Server and ready to handle commands
+%%%     active_bind - sent bind() request and waiting for response
 %%%----------------------------------------------------------------------
 
 %%-compile(export_all).
@@ -61,7 +65,7 @@
 
 %% gen_fsm callbacks
 -export([init/1, connecting/2,
-	 connecting/3, wait_bind_response/3, active/3, handle_event/3,
+	 connecting/3, wait_bind_response/3, active/3, active_bind/3, handle_event/3,
 	 handle_sync_event/4, handle_info/3, terminate/3, code_change/4]).
 
 
@@ -73,22 +77,23 @@
 -define(LDAP_VERSION, 3).
 -define(RETRY_TIMEOUT, 5000).
 -define(BIND_TIMEOUT, 10000).
--define(CMD_TIMEOUT, 5000).
+-define(CMD_TIMEOUT, 100000).
 -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
+		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
+		bind_q,        % Queue for bind() requests
+		debug_level    % Integer debug/logging level
 	       }).
 
 %%%----------------------------------------------------------------------
@@ -196,10 +201,10 @@ mod_replace(Type, Values) when list(Type), list(Values) -> m(replace, Type, Valu
 
 m(Operation, Type, Values) ->
     #'ModifyRequest_modification_SEQOF'{
-       operation = Operation,
-       modification = #'AttributeTypeAndValues'{
-	 type = Type,
-	 vals = Values}}.
+   operation = Operation,
+   modification = #'AttributeTypeAndValues'{
+     type = Type,
+     vals = Values}}.
 
 %%% --------------------------------------------------------------------
 %%% Modify an entry. Given an entry a number of modification
@@ -230,7 +235,7 @@ modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup)
 bind(Handle, RootDN, Passwd) 
   when list(RootDN),list(Passwd) ->
     Handle1 = get_handle(Handle),
-    gen_fsm:sync_send_event(Handle1, {bind, RootDN, Passwd}).
+    gen_fsm:sync_send_event(Handle1, {bind, RootDN, Passwd}, infinity).
 
 %%% Sanity checks !
 
@@ -266,7 +271,7 @@ optional(Value) -> Value.
 %%% --------------------------------------------------------------------
 search(Handle, A) when record(A, eldap_search) ->
     call_search(Handle, A);
-search(Handle, L) when list(Handle), list(L) ->
+search(Handle, L) when list(L) ->
     case catch parse_search_args(L) of
 	{error, Emsg}                  -> {error, Emsg};
 	{'EXIT', Emsg}                 -> {error, Emsg};
@@ -275,11 +280,11 @@ search(Handle, L) when list(Handle), list(L) ->
 
 call_search(Handle, A) ->
     Handle1 = get_handle(Handle),
-    gen_fsm:sync_send_event(Handle1, {search, A}).
+    gen_fsm:sync_send_event(Handle1, {search, A}, infinity).
 
 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) ->
@@ -292,6 +297,8 @@ 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([{limit, Limit}|T],A) when is_integer(Limit) ->
+    parse_search_args(T,A#eldap_search{limit = Limit});
 parse_search_args([H|T],A) ->
     throw({error,{unknown_arg, H}});
 parse_search_args([],A) ->
@@ -383,6 +390,7 @@ init({Hosts, Port, Rootdn, Passwd, Log}) ->
 			    id = 0,
 			    log = Log,
 			    dict = dict:new(),
+			    bind_q = queue:new(),
 			    debug_level = 0}, 0}.
 
 %%----------------------------------------------------------------------
@@ -417,13 +425,28 @@ wait_bind_response(Event, From, S) ->
 active(Event, From, S) ->
     case catch send_command(Event, From, S) of
 	{ok, NewS} ->
-	    {next_state, active, NewS};
+	    case Event of
+		{bind, _, _} ->
+		    {next_state, active_bind, NewS};
+		_ ->
+		    {next_state, active, NewS}
+	    end;
 	{error, Reason} ->
 	    {reply, {error, Reason}, active, S};
 	{'EXIT', Reason} ->
 	    {reply, {error, Reason}, active, S}
     end.
 
+active_bind({bind, RootDN, Passwd}, From, #eldap{bind_q=Q} = S) ->
+    NewQ = queue:in({{bind, RootDN, Passwd}, From}, Q),
+    {next_state, active_bind, S#eldap{bind_q=NewQ}};
+active_bind(Event, From, S) ->
+    case catch send_command(Event, From, S) of
+	{ok, NewS}       -> {next_state, active_bind, NewS};
+	{error, Reason}  -> {reply, {error, Reason}, active_bind, S};
+	{'EXIT', Reason} -> {reply, {error, Reason}, active_bind, S}
+    end.
+
 %%----------------------------------------------------------------------
 %% Func: handle_event/3
 %% Called when gen_fsm:send_all_state_event/2 is invoked.
@@ -435,6 +458,19 @@ handle_event(close, StateName, S) ->
     gen_tcp:close(S#eldap.fd),
     {stop, closed, S};
 
+handle_event(process_bind_q, active_bind, #eldap{bind_q=Q} = S) ->
+    case queue:out(Q) of
+	{{value, {BindEvent, To}}, NewQ} ->
+	    NewStateData = case catch send_command(BindEvent, To, S) of
+			       {ok, NewS}       -> NewS;
+			       {error, Reason}  -> gen_fsm:reply(To, {error, Reason}), S;
+			       {'EXIT', Reason} -> gen_fsm:reply(To, {error, Reason}), S
+			   end,
+	    {next_state, active_bind, NewStateData#eldap{bind_q=NewQ}};
+	{empty, Q} ->
+	    {next_state, active, S}
+    end;
+
 handle_event(Event, StateName, S) ->
     {next_state, StateName, S}.
 
@@ -484,13 +520,14 @@ handle_info({tcp, Socket, Data}, wait_bind_response, S) ->
 				{next_state, connecting, S#eldap{fd = null}}
     end;
 
-handle_info({tcp, Socket, Data}, active, S) ->
+handle_info({tcp, Socket, Data}, StateName, S)
+  when StateName==active; StateName==active_bind ->
     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}
+				    {next_state, StateName, NewS};
+	{ok, NewS}               -> {next_state, StateName, NewS};
+	{'EXIT', Reason}         -> {next_state, StateName, S};
+	{error, Reason}          -> {next_state, StateName, S}
     end;
 
 handle_info({tcp_closed, Socket}, All_fsm_states, S) ->
@@ -501,7 +538,7 @@ handle_info({tcp_closed, Socket}, All_fsm_states, S) ->
     dict:map(F, S#eldap.dict),
     retry_connect(),
     {next_state, connecting, S#eldap{fd = null,
-				     dict = dict:new()}};
+				     dict = dict:new(), bind_q=queue:new()}};
 
 handle_info({tcp_error, Socket, Reason}, Fsm_state, S) ->
     log1("eldap received tcp_error: ~p~nIn State: ~p~n", [Reason, Fsm_state], S),
@@ -529,7 +566,7 @@ handle_info({timeout, Timer, bind_timeout}, wait_bind_response, S) ->
 %%
 handle_info(Info, StateName, S) ->
     log1("eldap. Unexpected Info: ~p~nIn state: ~p~n when StateData is: ~p~n",
-			[Info, StateName, S], S),
+	 [Info, StateName, S], S),
     {next_state, StateName, S}.
 
 %%----------------------------------------------------------------------
@@ -569,7 +606,7 @@ gen_req({search, A}) ->
      #'SearchRequest'{baseObject   = A#eldap_search.base,
 		      scope        = v_scope(A#eldap_search.scope),
 		      derefAliases = neverDerefAliases,
-		      sizeLimit    = 0, % no size limit
+		      sizeLimit    = A#eldap_search.limit,
 		      timeLimit    = v_timeout(A#eldap_search.timeout),
 		      typesOnly    = v_bool(A#eldap_search.types_only),
 		      filter       = v_filter(A#eldap_search.filter),
@@ -620,23 +657,24 @@ recvd_packet(Pkt, S) ->
 	    {Timer, From, Name, Result_so_far} = get_op_rec(Id, Dict),
 	    case {Name, Op} of
 		{searchRequest, {searchResEntry, R}} when
-		      record(R,'SearchResultEntry') ->
+		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 ->
+		    Reason = Result#'LDAPResult'.resultCode,
+		    if
+			Reason==success; Reason=='sizeLimitExceeded' ->
 			    {Res, Ref} = polish(Result_so_far),
 			    New_dict = dict:erase(Id, Dict),
 			    cancel_timer(Timer),
 			    {reply, #eldap_search_result{entries = Res,
 							 referrals = Ref}, From,
-			                              S#eldap{dict = New_dict}};
-			Reason ->
+			     S#eldap{dict = New_dict}};
+			true ->
 			    New_dict = dict:erase(Id, Dict),
 			    cancel_timer(Timer),
 			    {reply, {error, Reason}, From, S#eldap{dict = New_dict}}
-			end;
+		    end;
 		{searchRequest, {searchResRef, R}} ->
 		    New_dict = dict:append(Id, R, Dict),
 		    {ok, S#eldap{dict = New_dict}};
@@ -664,12 +702,13 @@ recvd_packet(Pkt, S) ->
 		    New_dict = dict:erase(Id, Dict),
 		    cancel_timer(Timer),
 		    Reply = check_bind_reply(Result, From),
+		    gen_fsm:send_all_state_event(self(), process_bind_q),
 		    {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}}
+		     From, S#eldap{dict = New_dict}}
 	    end;
 	Error -> Error
     end.
@@ -773,7 +812,7 @@ cmd_timeout(Timer, Id, S) ->
 		    {reply, From, {timeout,
 				   #eldap_search_result{entries = Res1,
 							referrals = Ref1}},
-		                   S#eldap{dict = New_dict}};
+		     S#eldap{dict = New_dict}};
 		Others ->
 		    New_dict = dict:erase(Id, Dict),
 		    {reply, From, {error, timeout}, S#eldap{dict = New_dict}}
diff --git a/src/eldap/eldap.hrl b/src/eldap/eldap.hrl
index e31a34991..1f1a4e1a0 100644
--- a/src/eldap/eldap.hrl
+++ b/src/eldap/eldap.hrl
@@ -1,6 +1,7 @@
 -record(eldap_search, {scope = wholeSubtree,
 		       base = [],
 		       filter,
+		       limit = 0,
 		       attributes = [],
 		       types_only = false,
 		       timeout = 0}).
diff --git a/src/eldap/eldap_pool.erl b/src/eldap/eldap_pool.erl
new file mode 100644
index 000000000..959b16ac7
--- /dev/null
+++ b/src/eldap/eldap_pool.erl
@@ -0,0 +1,57 @@
+%%%-------------------------------------------------------------------
+%%% File    : eldap_pool.erl
+%%% Author  : Evgeniy Khramtsov <xram@jabber.ru>
+%%% Purpose : LDAP connections pool
+%%% Created : 12 Nov 2006 by Evgeniy Khramtsov <xram@jabber.ru>
+%%% Id      : $Id$
+%%%-------------------------------------------------------------------
+-module(eldap_pool).
+-author('xram@jabber.ru').
+
+%% API
+-export([
+	 start_link/6,
+	 bind/3,
+	 search/2
+	]).
+
+%%====================================================================
+%% API
+%%====================================================================
+bind(PoolName, DN, Passwd) ->
+    do_request(PoolName, {bind, [DN, Passwd]}).
+
+search(PoolName, Opts) ->
+    do_request(PoolName, {search, [Opts]}).
+
+start_link(Name, Hosts, Backups, Port, Rootdn, Passwd) ->
+    PoolName = make_id(Name),
+    pg2:create(PoolName),
+    lists:foreach(fun(Host) ->
+			  ID = erlang:ref_to_list(make_ref()),
+			  case catch eldap:start_link(ID, [Host|Backups], Port, Rootdn, Passwd) of
+			      {ok, Pid} ->
+				  pg2:join(PoolName, Pid);
+			      _ ->
+				  error
+			  end
+		  end, Hosts).
+
+%%====================================================================
+%% Internal functions
+%%====================================================================
+do_request(Name, {F, Args}) ->
+    case pg2:get_closest_pid(make_id(Name)) of
+	Pid when is_pid(Pid) ->
+	    case catch apply(eldap, F, [Pid | Args]) of
+		{'EXIT', Reason} ->
+		    {error, Reason};
+		Reply ->
+		    Reply
+	    end;
+	Err ->
+	    Err
+    end.
+
+make_id(Name) ->
+    list_to_atom("eldap_pool_" ++ Name).
diff --git a/src/eldap/eldap_utils.erl b/src/eldap/eldap_utils.erl
index 50a310859..64a70af41 100644
--- a/src/eldap/eldap_utils.erl
+++ b/src/eldap/eldap_utils.erl
@@ -16,7 +16,9 @@
 	 usort_attrs/1,
 	 get_user_part/2,
 	 make_filter/2,
-	 case_insensitive_match/2]).
+	 get_state/2,
+	 case_insensitive_match/2,
+	 uids_domain_subst/2]).
 
 %% Generate an 'or' LDAP query on one or several attributes
 %% If there is only one attribute
@@ -109,3 +111,17 @@ case_insensitive_match(X, Y) ->
 	true -> false
     end.
 
+get_state(Server, Module) ->
+    Proc = gen_mod:get_module_proc(Server, Module),
+    gen_server:call(Proc, get_state).
+
+%% From the list of uids attribute:
+%% we look from alias domain (%d) and make the substitution
+%% with the actual host domain
+%% This help when you need to configure many virtual domains.
+uids_domain_subst(Host, UIDs) ->
+    lists:map(fun({U,V}) ->
+                      {U, eldap_filter:do_sub(V,[{"%d", Host}])};
+                  (A) -> A 
+              end,
+              UIDs).
\ No newline at end of file