%%%----------------------------------------------------------------------
%%% File    : mod_vcard_ad.erl
%%% Author  : Stanislav Bogatyrev <realloc@realloc.spb.ru>
%%% Author  : Alexey Shchepin <alexey@sevcom.net>
%%% Author  : Alex <agent_007> Gorbachenko (agent_007@immo.ru)
%%% Purpose : 
%%% Created :  2 Jan 2003 by Alexey Shchepin <alexey@sevcom.net>
%%% Id      : $Id: mod_vcard_ad.erl 437 2005-11-19 01:20:05Z agent_007 $
%%%----------------------------------------------------------------------

-module(mod_vcard_ad).
-author('realloc@realloc.spb.ru').
-author('alexey@sevcom.net').
-author('agent_007@immo.ru').
-vsn('$Revision: 437 $ ').

-behaviour(gen_mod).

-export([start/2, init/3, stop/1,
 	 get_sm_features/5,
	 process_local_iq/3,
	 process_sm_iq/3,
	 remove_user/1]).

-include("ejabberd.hrl").
-include("eldap/eldap.hrl").
-include("jlib.hrl").

-define(PROCNAME, ejabberd_mod_vcard_ad).

start(Host, Opts) ->
    IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue),
    gen_iq_handler:add_iq_handler(ejabberd_local, Host, ?NS_VCARD,
				  ?MODULE, process_local_iq, IQDisc),
    gen_iq_handler:add_iq_handler(ejabberd_sm, Host, ?NS_VCARD,
				  ?MODULE, process_sm_iq, IQDisc),
    ejabberd_hooks:add(disco_sm_features, Host, ?MODULE, get_sm_features, 50),
    LDAPServers = ejabberd_config:get_local_option({ad_servers, Host}),
    RootDN = ejabberd_config:get_local_option({ad_rootdn, Host}),
    Password = ejabberd_config:get_local_option({ad_password, Host}),
    eldap:start_link("mod_vcard_ad", LDAPServers, 389, RootDN, Password),
    MyHost = gen_mod:get_opt(host, Opts, "vjud." ++ Host),
    Search = gen_mod:get_opt(search, Opts, true),
    register(gen_mod:get_module_proc(Host, ?PROCNAME),
	     spawn(?MODULE, init, [MyHost, Host, Search])).

init(Host, ServerHost, Search) ->
    case Search of
	false ->
	    loop(Host, ServerHost);
	_ ->
	    ejabberd_router:register_route(Host),
	    loop(Host, ServerHost)
    end.

loop(Host, ServerHost) ->
    receive
	{route, From, To, Packet} ->
	    case catch do_route(ServerHost, From, To, Packet) of
		{'EXIT', Reason} ->
		    ?ERROR_MSG("~p", [Reason]);
		_ ->
		    ok
	    end,
	    loop(Host, ServerHost);
	stop ->
	    ejabberd_router:unregister_route(Host),
	    ok;
	_ ->
	    loop(Host, ServerHost)
    end.

stop(Host) ->
    gen_iq_handler:remove_iq_handler(ejabberd_local, Host, ?NS_VCARD),
    gen_iq_handler:remove_iq_handler(ejabberd_sm, Host, ?NS_VCARD),
    ejabberd_hooks:delete(disco_sm_features, Host, ?MODULE, get_sm_features, 50),
    Proc = gen_mod:get_module_proc(Host, ?PROCNAME),
    Proc ! stop,
    {wait, Proc}.

get_sm_features({error, _Error} = Acc, _From, _To, _Node, _Lang) ->
    Acc;
get_sm_features(Acc, _From, _To, Node, _Lang) ->
    case Node of
 	[] ->
 	    case Acc of
 		{result, Features} ->
 		    {result, [?NS_VCARD | Features]};
 		empty ->
 		    {result, [?NS_VCARD]}
 	    end;
  	_ ->
 	    Acc
    end.

process_local_iq(_From, _To, #iq{type = Type, lang = Lang, sub_el = SubEl} = IQ) ->
    case Type of
	set ->
	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]};
	get ->
	    IQ#iq{type = result,
		  sub_el = [{xmlelement, "vCard",
			     [{"xmlns", ?NS_VCARD}],
			     [{xmlelement, "FN", [],
			       [{xmlcdata, "ejabberd"}]},
			      {xmlelement, "URL", [],
			       [{xmlcdata,
				 "http://ejabberd.jabberstudio.org/"}]},
			      {xmlelement, "DESC", [],
			       [{xmlcdata,
				 translate:translate(
				   Lang,
				   "Erlang Jabber Server\n"
				   "Copyright (c) 2002-2005 Alexey Shchepin")}]},
			      {xmlelement, "BDAY", [],
			       [{xmlcdata, "2002-11-16"}]}
			     ]}]}
    end.

find_ldap_user(Host, User) ->
    Attr = ejabberd_config:get_local_option({ad_uidattr, Host}),
    Filter = eldap:equalityMatch(Attr, User),
    Base = ejabberd_config:get_local_option({ad_base, Host}),
    case eldap:search("mod_vcard_ad", [{base, Base},
					 {filter, Filter},
					 {attributes, []}]) of
	#eldap_search_result{entries = [E | _]} ->
	    E;
	_ ->
	    false
    end.

is_attribute_read_allowed(Name,From,To) ->
    true.

ldap_attribute_to_vcard(Prefix,{Name,Values},From,To) ->
    case is_attribute_read_allowed(Name,From,To) of 
	true ->
	    ldap_lca_to_vcard(Prefix,stringprep:tolower(Name),Values);
	_ ->
	    none
    end.

ldap_lca_to_vcard(vCard,"displayname",[Value|_]) ->
    {xmlelement,"FN",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCard,"cn",[Value|_]) ->
    {xmlelement,"NICKNAME",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCard,"title",[Value|_]) ->
    {xmlelement,"TITLE",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCard,"wwwhomepage",[Value|_]) ->
    {xmlelement,"URL",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCard,"description",[Value|_]) ->
    {xmlelement,"DESC",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCard,"telephonenumber",[Value|_]) ->
    {xmlelement,"TEL",[],[{xmlelement,"VOICE",[],[]},
			  {xmlelement,"WORK",[],[]},
			  {xmlelement,"NUMBER",[],[{xmlcdata,Value}]}]};

ldap_lca_to_vcard(vCard,"mail",[Value|_]) ->
    {xmlelement,"EMAIL",[],[{xmlelement,"INTERNET",[],[]},
			    {xmlelement,"PREF",[],[]},
			    {xmlelement,"USERID",[],[{xmlcdata,Value}]}]};

ldap_lca_to_vcard(vCardN,"sn",[Value|_]) ->
    {xmlelement,"FAMILY",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCardN,"givenname",[Value|_]) ->
    {xmlelement,"GIVEN",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCardN,"initials",[Value|_]) ->
    {xmlelement,"MIDDLE",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCardAdr,"streetaddress",[Value|_]) ->
    {xmlelement,"STREET",[],[{xmlcdata,Value}]};
ldap_lca_to_vcard(vCardAdr,"co",[Value|_]) ->
    {xmlelement,"CTRY",[],[{xmlcdata,Value}]};
ldap_lca_to_vcard(vCardAdr,"l",[Value|_]) ->
    {xmlelement,"LOCALITY",[],[{xmlcdata,Value}]};
ldap_lca_to_vcard(vCardAdr,"st",[Value|_]) ->
    {xmlelement,"REGION",[],[{xmlcdata,Value}]};
ldap_lca_to_vcard(vCardAdr,"postalcode",[Value|_]) ->
    {xmlelement,"PCODE",[],[{xmlcdata,Value}]};
ldap_lca_to_vcard(vCardO,"company",[Value|_]) ->
    {xmlelement,"ORGNAME",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(vCardO,"department",[Value|_]) ->
    {xmlelement,"ORGUNIT",[],[{xmlcdata,Value}]};

ldap_lca_to_vcard(_,_,_) -> none.

ldap_attributes_to_vcard(Attributes,From,To) ->
    Elts = lists:map(fun(Attr) ->
			     ldap_attribute_to_vcard(vCard,Attr,From,To)
		     end,Attributes),
    FElts = [ X || X <- Elts, X /= none ],
    NElts = lists:map(fun(Attr) ->
			      ldap_attribute_to_vcard(vCardN,Attr,From,To)
		      end,Attributes),
    FNElts = [ X || X <- NElts, X /= none ],
   
    ADRElts = lists:map(fun(Attr) ->
			      ldap_attribute_to_vcard(vCardAdr,Attr,From,To)
		      end,Attributes),
    FADRElts = [ X || X <- ADRElts, X /= none ],
    
    OElts = lists:map(fun(Attr) ->
			      ldap_attribute_to_vcard(vCardO,Attr,From,To)
		      end,Attributes),
    FOElts = [ X || X <- OElts, X /= none ],
    [{xmlelement, "vCard", [{"xmlns", ?NS_VCARD}],
      lists:append(FElts,
		   [{xmlelement,"N",[],FNElts},
		    {xmlelement,"ADR",[],FADRElts},
		    {xmlelement,"ORG",[],FOElts}])
     }].

process_sm_iq(From, To, #iq{type = Type, sub_el = SubEl} = IQ) ->
    case Type of
	set ->
	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]};
	get ->
	    #jid{luser = LUser, lserver = LServer} = To,
	    case find_ldap_user(LServer, LUser) of
		#eldap_entry{attributes = Attributes} ->
		    Vcard = ldap_attributes_to_vcard(Attributes,From,To),
		    IQ#iq{type = result, sub_el = Vcard};
		_ ->
		    IQ#iq{type = result, sub_el = []}
	    end
	end.

-define(TLFIELD(Type, Label, Var),
	{xmlelement, "field", [{"type", Type},
			       {"label", translate:translate(Lang, Label)},
			       {"var", Var}], []}).


-define(FORM(JID),
	[{xmlelement, "instructions", [],
	  [{xmlcdata, translate:translate(Lang, "You need an x:data capable client to search")}]},
	 {xmlelement, "x", [{"xmlns", ?NS_XDATA}, {"type", "form"}],
	  [{xmlelement, "title", [],
	    [{xmlcdata, translate:translate(Lang, "Search users in ") ++
	      jlib:jid_to_string(JID)}]},
	   {xmlelement, "instructions", [],
	    [{xmlcdata, translate:translate(Lang, "Fill in fields to search "
					    "for any matching Jabber User")}]},
	   ?TLFIELD("text-single", "User", "user"),
	   ?TLFIELD("text-single", "Full Name", "fn"),
	   ?TLFIELD("text-single", "Given Name", "given"),
	   ?TLFIELD("text-single", "Middle Name", "middle"),
	   ?TLFIELD("text-single", "Family Name", "family"),
	   ?TLFIELD("text-single", "Nickname", "nickname"),
	   ?TLFIELD("text-single", "Birthday", "bday"),
	   ?TLFIELD("text-single", "Country", "ctry"),
	   ?TLFIELD("text-single", "City", "locality"),
	   ?TLFIELD("text-single", "email", "email"),
	   ?TLFIELD("text-single", "Organization Name", "orgname"),
	   ?TLFIELD("text-single", "Organization Unit", "orgunit")
	  ]}]).




do_route(ServerHost, From, To, Packet) ->
    #jid{user = User, resource = Resource} = To,
    if
	(User /= "") or (Resource /= "") ->
	    Err = jlib:make_error_reply(Packet, ?ERR_SERVICE_UNAVAILABLE),
	    ejabberd_router ! {route, To, From, Err};
	true ->
	    IQ = jlib:iq_query_info(Packet),
	    case IQ of
		#iq{type = Type, xmlns = ?NS_SEARCH, lang = Lang, sub_el = SubEl} ->
		    case Type of
			set ->
			    XDataEl = find_xdata_el(SubEl),
			    case XDataEl of
				false ->
				    Err = jlib:make_error_reply(
					    Packet, ?ERR_BAD_REQUEST),
				    ejabberd_router:route(To, From, Err);
				_ ->
				    XData = jlib:parse_xdata_submit(XDataEl),
				    case XData of
					invalid ->
					    Err = jlib:make_error_reply(
						    Packet,
						    ?ERR_BAD_REQUEST),
					    ejabberd_router:route(To, From,
								  Err);
					_ ->
					    ResIQ =
						IQ#iq{
						  type = result,
						  sub_el =
						  [{xmlelement,
						    "query",
						    [{"xmlns", ?NS_SEARCH}],
						    [{xmlelement, "x",
						      [{"xmlns", ?NS_XDATA},
						       {"type", "result"}],
						      search_result(Lang, To, ServerHost, XData)
						     }]}]},
					    ejabberd_router:route(
					      To, From, jlib:iq_to_xml(ResIQ))
				    end
			    end;
			get ->
			    ResIQ = IQ#iq{type = result,
					  sub_el = [{xmlelement,
						     "query",
						     [{"xmlns", ?NS_SEARCH}],
						     ?FORM(To)
						    }]},
			    ejabberd_router:route(To,
						  From,
						  jlib:iq_to_xml(ResIQ))
		    end;
		#iq{type = Type, xmlns = ?NS_DISCO_INFO, sub_el = SubEl} ->
		    case Type of
			set ->
			    Err = jlib:make_error_reply(
				    Packet, ?ERR_NOT_ALLOWED),
			    ejabberd_router:route(To, From, Err);
			get ->
			    ResIQ =
				IQ#iq{type = result,
				      sub_el = [{xmlelement,
						 "query",
						 [{"xmlns", ?NS_DISCO_INFO}],
						 [{xmlelement, "identity",
						   [{"category", "directory"},
						    {"type", "user"},
						    {"name",
						     "vCard User Search"}],
						   []},
						  {xmlelement, "feature",
						   [{"var", ?NS_SEARCH}], []},
						  {xmlelement, "feature",
						   [{"var", ?NS_VCARD}], []}
						 ]
						}]},
			    ejabberd_router:route(To,
						  From,
						  jlib:iq_to_xml(ResIQ))
		    end;
		#iq{type = Type, xmlns = ?NS_DISCO_ITEMS, sub_el = SubEl} ->
		    case Type of
			set ->
			    Err = jlib:make_error_reply(
				    Packet, ?ERR_NOT_ALLOWED),
			    ejabberd_router:route(To, From, Err);
			get ->
			    ResIQ = 
				IQ#iq{type = result,
				      sub_el = [{xmlelement,
						 "query",
						 [{"xmlns", ?NS_DISCO_ITEMS}],
						 []}]},
			    ejabberd_router:route(To,
						  From,
						  jlib:iq_to_xml(ResIQ))
		    end;
		#iq{type = get, xmlns = ?NS_VCARD, lang = Lang} ->
		    ResIQ = 
			IQ#iq{type = result,
			      sub_el = [{xmlelement,
					 "vCard",
					 [{"xmlns", ?NS_VCARD}],
					 iq_get_vcard(Lang)}]},
		    ejabberd_router:route(To,
					  From,
					  jlib:iq_to_xml(ResIQ));
		_ ->
		    Err = jlib:make_error_reply(Packet,
						?ERR_SERVICE_UNAVAILABLE),
		    ejabberd_router:route(To, From, Err)
	    end
    end.

iq_get_vcard(Lang) ->
    [{xmlelement, "FN", [],
      [{xmlcdata, "ejabberd/mod_vcard"}]},
     {xmlelement, "URL", [],
      [{xmlcdata,
        "http://ejabberd.jabberstudio.org/"}]},
     {xmlelement, "DESC", [],
      [{xmlcdata, translate:translate(
		    Lang,
		    "ejabberd vCard module\n"
		    "Copyright (c) 2003-2005 Alexey Shchepin")}]}].

find_xdata_el({xmlelement, _Name, _Attrs, SubEls}) ->
    find_xdata_el1(SubEls).

find_xdata_el1([]) ->
    false;
find_xdata_el1([{xmlelement, Name, Attrs, SubEls} | Els]) ->
    case xml:get_attr_s("xmlns", Attrs) of
	?NS_XDATA ->
	    {xmlelement, Name, Attrs, SubEls};
	_ ->
	    find_xdata_el1(Els)
    end;
find_xdata_el1([_ | Els]) ->
    find_xdata_el1(Els).

-define(LFIELD(Label, Var),
	{xmlelement, "field", [{"label", translate:translate(Lang, Label)},
			       {"var", Var}], []}).

search_result(Lang, JID, ServerHost, Data) ->
    [{xmlelement, "title", [],
      [{xmlcdata, translate:translate(Lang, "Results of search in ") ++
	jlib:jid_to_string(JID)}]},
     {xmlelement, "reported", [],
      [?LFIELD("JID", "jid"),
       ?LFIELD("Full Name", "fn"),
       ?LFIELD("Given Name", "given"),
       ?LFIELD("Middle Name", "middle"),
       ?LFIELD("Family Name", "family"),
       ?LFIELD("Nickname", "nickname"),
       ?LFIELD("Birthday", "bday"),
       ?LFIELD("Country", "ctry"),
       ?LFIELD("City", "locality"),
       ?LFIELD("email", "email"),
       ?LFIELD("Organization Name", "orgname"),
       ?LFIELD("Organization Unit", "orgunit")
      ]}] ++ lists:map(fun(E) -> 
			       record_to_item(E#eldap_entry.attributes)
		       end, search(ServerHost, Data)).

-define(FIELD(Var, Val),
	{xmlelement, "field", [{"var", Var}],
	 [{xmlelement, "value", [],
	   [{xmlcdata, Val}]}]}).

case_exact_compare(none,_) ->
    false;
case_exact_compare(_,none) ->
    false;
case_exact_compare(X,Y) ->
    X > Y.

ldap_sort_entries(L) ->
    lists:sort(fun(E1,E2) ->
		       case_exact_compare(ldap_get_value(E1,"cn"),ldap_get_value(E2,"cn"))
	       end,L).

ldap_get_value(E,Attribute) ->
    #eldap_entry{attributes = Attributes} = E,
    case lists:filter(fun({A,_}) ->
			      string:equal(A,Attribute)
		      end,Attributes) of
	[{Attr,[Value|_]}] ->
	    Value;
	_ -> 
	    none
    end.

ldap_attribute_to_item("samaccountname",Value) ->
    [
     ?FIELD("jid",Value ++ "@" ++ ?MYNAME),
     ?FIELD("uid",Value)
    ];

ldap_attribute_to_item("cn",Value) ->
    [
     ?FIELD("nickname",Value)
    ];

ldap_attribute_to_item("displayname",Value) ->
    [
     ?FIELD("fn",Value)
    ];

ldap_attribute_to_item("sn",Value) ->
    [
     ?FIELD("family",Value)
    ];
ldap_attribute_to_item("co",Value) ->
    [
     ?FIELD("ctry",Value)
    ];
ldap_attribute_to_item("l",Value) ->
    [
     ?FIELD("locality",Value)
    ];

ldap_attribute_to_item("givenname",Value) ->
    [
     ?FIELD("given",Value)
    ];

ldap_attribute_to_item("initials",Value) ->
    [
     ?FIELD("middle",Value)
    ];

ldap_attribute_to_item("mail",Value) ->
    [
     ?FIELD("email",Value)
    ];

ldap_attribute_to_item("company",Value) ->
    [
     ?FIELD("orgname",Value)
    ];

ldap_attribute_to_item("department",Value) ->
    [
     ?FIELD("orgunit",Value)
    ];

ldap_attribute_to_item(_,_) ->
    [none].

record_to_item(Attributes) ->
    List = lists:append(lists:map(fun({Attr,[Value|_]}) -> 
					  ldap_attribute_to_item(stringprep:tolower(Attr),Value)
				  end,Attributes)),
    FList = [X || X <- List, X /= none],
    {xmlelement, "item", [],FList}.

search(LServer, Data) ->
    AdGroup = ejabberd_config:get_local_option({ad_group, LServer}),
    FilterDef = make_filter(Data),
    FilterPerson =  eldap:equalityMatch("objectCategory", "person"),
    FilterComp = eldap:equalityMatch("objectClass", "computer"),
    FilterHidden = eldap:equalityMatch("description", "hidden"),
    FilterGroup = eldap:equalityMatch("memberOf", AdGroup),
    FilterLive = eldap:equalityMatch("userAccountControl", "66050"),
    Filter = eldap:'and'([
			  FilterDef,
			  FilterPerson,
			  FilterGroup,
			  eldap:'not'(FilterComp),
			  eldap:'not'(FilterHidden),
			  eldap:'not'(FilterLive)]),
    Base = ejabberd_config:get_local_option({ad_base, LServer}),
    UIDAttr = ejabberd_config:get_local_option({ad_uidattr, LServer}),
    case eldap:search("mod_vcard_ad",[{base, Base},
					{filter, Filter},
					{attributes, []}]) of
	#eldap_search_result{entries = E} ->
	    [X || X <- E,
		  ejabberd_auth:is_user_exists(
		    ldap_get_value(X, UIDAttr), LServer)];
	Err ->
	    ?ERROR_MSG("Bad search: ~p", [[LServer, {base, Base},
					{filter, Filter},
					{attributes, []}]])
    end.


make_filter(Data) ->
    Filter = [X || X <- lists:map(fun(R) -> 
					  make_assertion(R)
				  end, Data),
		   X /= none ],
    case Filter of
	[F] -> 
	    F;
	_ ->
	    eldap:'and'(Filter)
    end.


make_assertion("givenName",Value) ->
    eldap:substrings("givenName",[{any,Value}]);

make_assertion("cn",Value) ->
    eldap:substrings("cn",[{any,Value}]);

make_assertion("sn",Value) ->
    eldap:substrings("sn",[{any,Value}]);

make_assertion(Attr, Value) ->
    eldap:equalityMatch(Attr,Value).

make_assertion({SVar, [Val]}) ->
    LAttr = ldap_attribute(SVar),
    case LAttr of
	none ->
	    none;
	_ ->
	    if 
		is_list(Val) and (Val /= "") ->
		    make_assertion(LAttr,Val);
		true ->
		    none
	    end
    end.

ldap_attribute("user") ->
    "samaccountname";

ldap_attribute("fn") ->
    "cn";

ldap_attribute("family") ->
    "sn";

ldap_attribute("given") ->
    "givenName";

ldap_attribute("middle") ->
    "initials";

ldap_attribute("email") ->
    "mail";

ldap_attribute("orgname") ->
    "company";

ldap_attribute("orgunit") ->
    "department";

ldap_attribute(_) ->
    none.

remove_user(User) ->
    true.