%%%---------------------------------------------------------------------- %%% File : jlib.erl %%% Author : Alexey Shchepin %%% Purpose : General XMPP library. %%% Created : 23 Nov 2002 by Alexey Shchepin %%% %%% %%% ejabberd, Copyright (C) 2002-2008 Process-one %%% %%% 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 %%% %%%---------------------------------------------------------------------- -module(jlib). -author('alexey@process-one.net'). -export([make_result_iq_reply/1, make_error_reply/3, make_error_reply/2, make_error_element/2, make_correct_from_to_attrs/3, replace_from_to_attrs/3, replace_from_to/3, remove_attr/2, make_jid/3, make_jid/1, string_to_jid/1, jid_to_string/1, is_nodename/1, tolower/1, nodeprep/1, nameprep/1, resourceprep/1, jid_tolower/1, jid_remove_resource/1, jid_replace_resource/2, get_iq_namespace/1, iq_query_info/1, iq_query_or_response_info/1, is_iq_request_type/1, iq_to_xml/1, parse_xdata_submit/1, timestamp_to_iso/1, timestamp_to_xml/1, now_to_utc_string/1, now_to_local_string/1, datetime_string_to_timestamp/1, decode_base64/1, encode_base64/1, ip_to_list/1, from_old_jid/1, to_old_jid/1, short_jid/1, short_bare_jid/1]). -include("jlib.hrl"). %send_iq(From, To, ID, SubTags) -> % ok. make_result_iq_reply({xmlelement, Name, Attrs, SubTags}) -> NewAttrs = make_result_iq_reply_attrs(Attrs), {xmlelement, Name, NewAttrs, SubTags}. make_result_iq_reply_attrs(Attrs) -> To = xml:get_attr("to", Attrs), From = xml:get_attr("from", Attrs), Attrs1 = lists:keydelete("to", 1, Attrs), Attrs2 = lists:keydelete("from", 1, Attrs1), Attrs3 = case To of {value, ToVal} -> [{"from", ToVal} | Attrs2]; _ -> Attrs2 end, Attrs4 = case From of {value, FromVal} -> [{"to", FromVal} | Attrs3]; _ -> Attrs3 end, Attrs5 = lists:keydelete("type", 1, Attrs4), Attrs6 = [{"type", "result"} | Attrs5], Attrs6. make_error_reply({xmlelement, Name, Attrs, SubTags}, Code, Desc) -> NewAttrs = make_error_reply_attrs(Attrs), {xmlelement, Name, NewAttrs, SubTags ++ [{xmlelement, "error", [{"code", Code}], [{xmlcdata, Desc}]}]}. make_error_reply({xmlelement, Name, Attrs, SubTags}, Error) -> NewAttrs = make_error_reply_attrs(Attrs), {xmlelement, Name, NewAttrs, SubTags ++ [Error]}. make_error_reply_attrs(Attrs) -> To = xml:get_attr("to", Attrs), From = xml:get_attr("from", Attrs), Attrs1 = lists:keydelete("to", 1, Attrs), Attrs2 = lists:keydelete("from", 1, Attrs1), Attrs3 = case To of {value, ToVal} -> [{"from", ToVal} | Attrs2]; _ -> Attrs2 end, Attrs4 = case From of {value, FromVal} -> [{"to", FromVal} | Attrs3]; _ -> Attrs3 end, Attrs5 = lists:keydelete("type", 1, Attrs4), Attrs6 = [{"type", "error"} | Attrs5], Attrs6. make_error_element(Code, Desc) -> {xmlelement, "error", [{"code", Code}], [{xmlcdata, Desc}]}. make_correct_from_to_attrs(From, To, Attrs) -> Attrs1 = lists:keydelete("from", 1, Attrs), Attrs2 = case xml:get_attr("to", Attrs) of {value, _} -> Attrs1; _ -> [{"to", To} | Attrs1] end, Attrs3 = [{"from", From} | Attrs2], Attrs3. replace_from_to_attrs(From, To, Attrs) -> Attrs1 = lists:keydelete("to", 1, Attrs), Attrs2 = lists:keydelete("from", 1, Attrs1), Attrs3 = [{"to", To} | Attrs2], Attrs4 = [{"from", From} | Attrs3], Attrs4. replace_from_to(From, To, {xmlelement, Name, Attrs, Els}) -> NewAttrs = replace_from_to_attrs(jlib:jid_to_string(From), jlib:jid_to_string(To), Attrs), {xmlelement, Name, NewAttrs, Els}. remove_attr(Attr, {xmlelement, Name, Attrs, Els}) -> NewAttrs = lists:keydelete(Attr, 1, Attrs), {xmlelement, Name, NewAttrs, Els}. make_jid(User, Server, Resource) -> case nodeprep(User) of error -> error; LUser -> case nameprep(Server) of error -> error; LServer -> case resourceprep(Resource) of error -> error; LResource -> #jid{user = User, server = Server, resource = Resource, luser = LUser, lserver = LServer, lresource = LResource} end end end. make_jid({User, Server, Resource}) -> make_jid(User, Server, Resource). string_to_jid(J) -> string_to_jid1(J, ""). string_to_jid1([$@ | _J], "") -> error; string_to_jid1([$@ | J], N) -> string_to_jid2(J, lists:reverse(N), ""); string_to_jid1([$/ | _J], "") -> error; string_to_jid1([$/ | J], N) -> string_to_jid3(J, "", lists:reverse(N), ""); string_to_jid1([C | J], N) -> string_to_jid1(J, [C | N]); string_to_jid1([], "") -> error; string_to_jid1([], N) -> make_jid("", lists:reverse(N), ""). %% Only one "@" is admitted per JID string_to_jid2([$@ | _J], _N, _S) -> error; string_to_jid2([$/ | _J], _N, "") -> error; string_to_jid2([$/ | J], N, S) -> string_to_jid3(J, N, lists:reverse(S), ""); string_to_jid2([C | J], N, S) -> string_to_jid2(J, N, [C | S]); string_to_jid2([], _N, "") -> error; string_to_jid2([], N, S) -> make_jid(N, lists:reverse(S), ""). string_to_jid3([C | J], N, S, R) -> string_to_jid3(J, N, S, [C | R]); string_to_jid3([], N, S, R) -> make_jid(N, S, lists:reverse(R)). jid_to_string(#jid{user = User, server = Server, resource = Resource}) -> jid_to_string({User, Server, Resource}); jid_to_string({Node, Server, Resource}) -> S1 = case Node of "" -> ""; _ -> Node ++ "@" end, S2 = S1 ++ Server, S3 = case Resource of "" -> S2; _ -> S2 ++ "/" ++ Resource end, S3. is_nodename([]) -> false; is_nodename(J) -> nodeprep(J) /= error. %tolower_c(C) when C >= $A, C =< $Z -> % C + 32; %tolower_c(C) -> % C. -define(LOWER(Char), if Char >= $A, Char =< $Z -> Char + 32; true -> Char end). %tolower(S) -> % lists:map(fun tolower_c/1, S). %tolower(S) -> % [?LOWER(Char) || Char <- S]. % Not tail-recursive but it seems works faster than variants above tolower([C | Cs]) -> if C >= $A, C =< $Z -> [C + 32 | tolower(Cs)]; true -> [C | tolower(Cs)] end; tolower([]) -> []. %tolower([C | Cs]) when C >= $A, C =< $Z -> % [C + 32 | tolower(Cs)]; %tolower([C | Cs]) -> % [C | tolower(Cs)]; %tolower([]) -> % []. nodeprep(S) when length(S) < 1024 -> R = stringprep:nodeprep(S), if length(R) < 1024 -> R; true -> error end; nodeprep(_) -> error. nameprep(S) when length(S) < 1024 -> R = stringprep:nameprep(S), if length(R) < 1024 -> R; true -> error end; nameprep(_) -> error. resourceprep(S) when length(S) < 1024 -> R = stringprep:resourceprep(S), if length(R) < 1024 -> R; true -> error end; resourceprep(_) -> error. jid_tolower(#jid{luser = U, lserver = S, lresource = R}) -> {U, S, R}; jid_tolower({U, S, R}) -> case nodeprep(U) of error -> error; LUser -> case nameprep(S) of error -> error; LServer -> case resourceprep(R) of error -> error; LResource -> {LUser, LServer, LResource} end end end. jid_remove_resource(#jid{} = JID) -> JID#jid{resource = "", lresource = ""}; jid_remove_resource({U, S, _R}) -> {U, S, ""}. jid_replace_resource(JID, Resource) -> case resourceprep(Resource) of error -> error; LResource -> JID#jid{resource = Resource, lresource = LResource} end. get_iq_namespace({xmlelement, Name, _Attrs, Els}) when Name == "iq" -> case xml:remove_cdata(Els) of [{xmlelement, _Name2, Attrs2, _Els2}] -> xml:get_attr_s("xmlns", Attrs2); _ -> "" end; get_iq_namespace(_) -> "". iq_query_info(El) -> iq_info_internal(El, request). iq_query_or_response_info(El) -> iq_info_internal(El, any). iq_info_internal({xmlelement, Name, Attrs, Els}, Filter) when Name == "iq" -> %% Filter is either request or any. If it is request, any replies %% are converted to the atom reply. ID = xml:get_attr_s("id", Attrs), Type = xml:get_attr_s("type", Attrs), Lang = xml:get_attr_s("xml:lang", Attrs), {Type1, Class} = case Type of "set" -> {set, request}; "get" -> {get, request}; "result" -> {result, reply}; "error" -> {error, reply}; _ -> {invalid, invalid} end, if Type1 == invalid -> invalid; Class == request; Filter == any -> %% The iq record is a bit strange. The sub_el field is an %% XML tuple for requests, but a list of XML tuples for %% responses. FilteredEls = xml:remove_cdata(Els), {XMLNS, SubEl} = case {Class, FilteredEls} of {request, [{xmlelement, _Name2, Attrs2, _Els2}]} -> {xml:get_attr_s("xmlns", Attrs2), hd(FilteredEls)}; {reply, _} -> %% Find the namespace of the first non-error %% element, if there is one. NonErrorEls = [El || {xmlelement, SubName, _, _} = El <- FilteredEls, SubName /= "error"], {case NonErrorEls of [NonErrorEl] -> xml:get_tag_attr_s("xmlns", NonErrorEl); _ -> invalid end, FilteredEls}; _ -> {invalid, invalid} end, if XMLNS == "", Class == request -> invalid; true -> #iq{id = ID, type = Type1, xmlns = XMLNS, lang = Lang, sub_el = SubEl} end; Class == reply, Filter /= any -> reply end; iq_info_internal(_, _) -> not_iq. is_iq_request_type(set) -> true; is_iq_request_type(get) -> true; is_iq_request_type(_) -> false. iq_type_to_string(set) -> "set"; iq_type_to_string(get) -> "get"; iq_type_to_string(result) -> "result"; iq_type_to_string(error) -> "error"; iq_type_to_string(_) -> invalid. iq_to_xml(#iq{id = ID, type = Type, sub_el = SubEl}) -> if ID /= "" -> {xmlelement, "iq", [{"id", ID}, {"type", iq_type_to_string(Type)}], SubEl}; true -> {xmlelement, "iq", [{"type", iq_type_to_string(Type)}], SubEl} end. parse_xdata_submit(El) -> {xmlelement, _Name, Attrs, Els} = El, case xml:get_attr_s("type", Attrs) of "submit" -> lists:reverse(parse_xdata_fields(Els, [])); _ -> invalid end. parse_xdata_fields([], Res) -> Res; parse_xdata_fields([{xmlelement, Name, Attrs, SubEls} | Els], Res) -> case Name of "field" -> case xml:get_attr_s("var", Attrs) of "" -> parse_xdata_fields(Els, Res); Var -> Field = {Var, lists:reverse(parse_xdata_values(SubEls, []))}, parse_xdata_fields(Els, [Field | Res]) end; _ -> parse_xdata_fields(Els, Res) end; parse_xdata_fields([_ | Els], Res) -> parse_xdata_fields(Els, Res). parse_xdata_values([], Res) -> Res; parse_xdata_values([{xmlelement, Name, _Attrs, SubEls} | Els], Res) -> case Name of "value" -> Val = xml:get_cdata(SubEls), parse_xdata_values(Els, [Val | Res]); _ -> parse_xdata_values(Els, Res) end; parse_xdata_values([_ | Els], Res) -> parse_xdata_values(Els, Res). timestamp_to_iso({{Year, Month, Day}, {Hour, Minute, Second}}) -> lists:flatten( io_lib:format("~4..0w~2..0w~2..0wT~2..0w:~2..0w:~2..0w", [Year, Month, Day, Hour, Minute, Second])). timestamp_to_xml({{Year, Month, Day}, {Hour, Minute, Second}}) -> {xmlelement, "x", [{"xmlns", ?NS_DELAY}, {"stamp", lists:flatten( io_lib:format("~4..0w~2..0w~2..0wT~2..0w:~2..0w:~2..0w", [Year, Month, Day, Hour, Minute, Second]))}], []}. now_to_utc_string({MegaSecs, Secs, MicroSecs}) -> {{Year, Month, Day}, {Hour, Minute, Second}} = calendar:now_to_universal_time({MegaSecs, Secs, MicroSecs}), lists:flatten( io_lib:format("~4..0w-~2..0w-~2..0wT~2..0w:~2..0w:~2..0w.~6..0wZ", [Year, Month, Day, Hour, Minute, Second, MicroSecs])). now_to_local_string({MegaSecs, Secs, MicroSecs}) -> LocalTime = calendar:now_to_local_time({MegaSecs, Secs, MicroSecs}), UTCTime = calendar:now_to_universal_time({MegaSecs, Secs, MicroSecs}), Seconds = calendar:datetime_to_gregorian_seconds(LocalTime) - calendar:datetime_to_gregorian_seconds(UTCTime), {{H, M, _}, Sign} = if Seconds < 0 -> {calendar:seconds_to_time(-Seconds), "-"}; true -> {calendar:seconds_to_time(Seconds), "+"} end, {{Year, Month, Day}, {Hour, Minute, Second}} = LocalTime, lists:flatten( io_lib:format("~4..0w-~2..0w-~2..0wT~2..0w:~2..0w:~2..0w.~6..0w~s~2..0w:~2..0w", [Year, Month, Day, Hour, Minute, Second, MicroSecs, Sign, H, M])). % yyyy-mm-ddThh:mm:ss[.sss]{Z|{+|-}hh:mm} -> {MegaSecs, Secs, MicroSecs} datetime_string_to_timestamp(TimeStr) -> case catch parse_datetime(TimeStr) of {'EXIT', _Err} -> undefined; TimeStamp -> TimeStamp end. parse_datetime(TimeStr) -> [Date, Time] = string:tokens(TimeStr, "T"), D = parse_date(Date), {T, MS, TZH, TZM} = parse_time(Time), S = calendar:datetime_to_gregorian_seconds({D, T}), S1 = calendar:datetime_to_gregorian_seconds({{1970, 1, 1}, {0, 0, 0}}), Seconds = (S - S1) - TZH * 60 * 60 - TZM * 60, {Seconds div 1000000, Seconds rem 1000000, MS}. % yyyy-mm-dd parse_date(Date) -> [Y, M, D] = string:tokens(Date, "-"), Date1 = {list_to_integer(Y), list_to_integer(M), list_to_integer(D)}, case calendar:valid_date(Date1) of true -> Date1; _ -> false end. % hh:mm:ss[.sss]TZD parse_time(Time) -> case string:str(Time, "Z") of 0 -> parse_time_with_timezone(Time); _ -> [T | _] = string:tokens(Time, "Z"), {TT, MS} = parse_time1(T), {TT, MS, 0, 0} end. parse_time_with_timezone(Time) -> case string:str(Time, "+") of 0 -> case string:str(Time, "-") of 0 -> false; _ -> parse_time_with_timezone(Time, "-") end; _ -> parse_time_with_timezone(Time, "+") end. parse_time_with_timezone(Time, Delim) -> [T, TZ] = string:tokens(Time, Delim), {TZH, TZM} = parse_timezone(TZ), {TT, MS} = parse_time1(T), case Delim of "-" -> {TT, MS, -TZH, -TZM}; "+" -> {TT, MS, TZH, TZM} end. parse_timezone(TZ) -> [H, M] = string:tokens(TZ, ":"), {[H1, M1], true} = check_list([{H, 12}, {M, 60}]), {H1, M1}. parse_time1(Time) -> [HMS | T] = string:tokens(Time, "."), MS = case T of [] -> 0; [Val] -> list_to_integer(string:left(Val, 6, $0)) end, [H, M, S] = string:tokens(HMS, ":"), {[H1, M1, S1], true} = check_list([{H, 24}, {M, 60}, {S, 60}]), {{H1, M1, S1}, MS}. check_list(List) -> lists:mapfoldl( fun({L, N}, B)-> V = list_to_integer(L), if (V >= 0) and (V =< N) -> {V, B}; true -> {false, false} end end, true, List). % % Base64 stuff (based on httpd_util.erl) % decode_base64(S) -> decode1_base64([C || C <- S, C /= $ , C /= $\t, C /= $\n, C /= $\r]). decode1_base64([]) -> []; decode1_base64([Sextet1,Sextet2,$=,$=|Rest]) -> Bits2x6= (d(Sextet1) bsl 18) bor (d(Sextet2) bsl 12), Octet1=Bits2x6 bsr 16, [Octet1|decode_base64(Rest)]; decode1_base64([Sextet1,Sextet2,Sextet3,$=|Rest]) -> Bits3x6= (d(Sextet1) bsl 18) bor (d(Sextet2) bsl 12) bor (d(Sextet3) bsl 6), Octet1=Bits3x6 bsr 16, Octet2=(Bits3x6 bsr 8) band 16#ff, [Octet1,Octet2|decode_base64(Rest)]; decode1_base64([Sextet1,Sextet2,Sextet3,Sextet4|Rest]) -> Bits4x6= (d(Sextet1) bsl 18) bor (d(Sextet2) bsl 12) bor (d(Sextet3) bsl 6) bor d(Sextet4), Octet1=Bits4x6 bsr 16, Octet2=(Bits4x6 bsr 8) band 16#ff, Octet3=Bits4x6 band 16#ff, [Octet1,Octet2,Octet3|decode_base64(Rest)]; decode1_base64(_CatchAll) -> "". d(X) when X >= $A, X =<$Z -> X-65; d(X) when X >= $a, X =<$z -> X-71; d(X) when X >= $0, X =<$9 -> X+4; d($+) -> 62; d($/) -> 63; d(_) -> 63. encode_base64([]) -> []; encode_base64([A]) -> [e(A bsr 2), e((A band 3) bsl 4), $=, $=]; encode_base64([A,B]) -> [e(A bsr 2), e(((A band 3) bsl 4) bor (B bsr 4)), e((B band 15) bsl 2), $=]; encode_base64([A,B,C|Ls]) -> encode_base64_do(A,B,C, Ls). encode_base64_do(A,B,C, Rest) -> BB = (A bsl 16) bor (B bsl 8) bor C, [e(BB bsr 18), e((BB bsr 12) band 63), e((BB bsr 6) band 63), e(BB band 63)|encode_base64(Rest)]. e(X) when X >= 0, X < 26 -> X+65; e(X) when X>25, X<52 -> X+71; e(X) when X>51, X<62 -> X-4; e(62) -> $+; e(63) -> $/; e(X) -> exit({bad_encode_base64_token, X}). %% Convert Erlang inet IP to list ip_to_list({IP, _Port}) -> ip_to_list(IP); ip_to_list({A,B,C,D}) -> lists:flatten(io_lib:format("~w.~w.~w.~w",[A,B,C,D])). % -------------------------------------------------------------------- % Compat layer. % -------------------------------------------------------------------- %% @spec (JID) -> New_JID %% JID = jid() %% New_JID = jid() %% @doc Convert a JID from its ejabberd form to its exmpp form. %% %% Empty fields are set to `undefined', not the empty string. from_old_jid(#jid{user = Node, resource = Resource, luser = LNode, lresource = LResource} = JID) -> {Node1, LNode1} = case Node of "" -> {undefined, undefined}; _ -> {Node, LNode} end, {Resource1, LResource1} = case Resource of "" -> {undefined, undefined}; _ -> {Resource, LResource} end, JID#jid{user = Node1, resource = Resource1, luser = LNode1, lresource = LResource1}. %% @spec (JID) -> New_JID %% JID = jid() %% New_JID = jid() %% @doc Convert a JID from its exmpp form to its ejabberd form. %% %% Empty fields are set to the empty string, not `undefined'. to_old_jid(#jid{user = Node, resource = Resource, luser = LNode, lresource = LResource} = JID) -> {Node1, LNode1} = case Node of undefined -> {"", ""}; _ -> {Node, LNode} end, {Resource1, LResource1} = case Resource of undefined -> {"", ""}; _ -> {Resource, LResource} end, JID#jid{user = Node1, resource = Resource1, luser = LNode1, lresource = LResource1}. short_jid(JID) -> JID1 = to_old_jid(JID), {JID1#jid.luser, JID1#jid.lserver, JID1#jid.lresource}. short_bare_jid(JID) -> JID1 = to_old_jid(exmpp_jid:jid_to_bare_jid(JID)), {JID1#jid.luser, JID1#jid.lserver, JID1#jid.lresource}.