mirror of
https://github.com/processone/ejabberd.git
synced 2024-12-22 17:28:25 +01:00
933 lines
28 KiB
Erlang
933 lines
28 KiB
Erlang
%%%----------------------------------------------------------------------
|
|
%%% File : jlib.erl
|
|
%%% Author : Alexey Shchepin <alexey@process-one.net>
|
|
%%% Purpose : General XMPP library.
|
|
%%% Created : 23 Nov 2002 by Alexey Shchepin <alexey@process-one.net>
|
|
%%%
|
|
%%%
|
|
%%% ejabberd, Copyright (C) 2002-2016 ProcessOne
|
|
%%%
|
|
%%% 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.,
|
|
%%% 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
%%%
|
|
%%%----------------------------------------------------------------------
|
|
|
|
-module(jlib).
|
|
|
|
-author('alexey@process-one.net').
|
|
|
|
-protocol({xep, 59, '1.0'}).
|
|
-protocol({xep, 82, '1.1'}).
|
|
-protocol({xep, 203, '2.0'}).
|
|
|
|
-compile({no_auto_import, [atom_to_binary/2,
|
|
binary_to_integer/1,
|
|
integer_to_binary/1]}).
|
|
|
|
-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, replace_from_attrs/2, replace_from/2,
|
|
remove_attr/2, tolower/1,
|
|
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,
|
|
is_standalone_chat_state/1,
|
|
add_delay_info/3, add_delay_info/4,
|
|
timestamp_to_legacy/1, timestamp_to_iso_basic/1, timestamp_to_iso/2,
|
|
now_to_utc_string/1, now_to_local_string/1,
|
|
datetime_string_to_timestamp/1,
|
|
term_to_base64/1, base64_to_term/1,
|
|
decode_base64/1, encode_base64/1, ip_to_list/1,
|
|
rsm_encode/1, rsm_encode/2, rsm_decode/1,
|
|
binary_to_integer/1, binary_to_integer/2,
|
|
integer_to_binary/1, integer_to_binary/2,
|
|
atom_to_binary/1, binary_to_atom/1, tuple_to_binary/1,
|
|
l2i/1, i2l/1, i2l/2, queue_drop_while/2]).
|
|
|
|
%% The following functions are deprecated and will be removed soon
|
|
%% Use corresponding functions from jid.erl instead
|
|
-export([make_jid/3, make_jid/1, split_jid/1, string_to_jid/1,
|
|
jid_to_string/1, is_nodename/1, nodeprep/1,
|
|
nameprep/1, resourceprep/1, jid_tolower/1,
|
|
jid_remove_resource/1, jid_replace_resource/2]).
|
|
|
|
-deprecated([{make_jid, '_'},
|
|
{split_jid, 1},
|
|
{string_to_jid, 1},
|
|
{jid_to_string, 1},
|
|
{is_nodename, 1},
|
|
{nodeprep, 1},
|
|
{nameprep, 1},
|
|
{resourceprep, 1},
|
|
{jid_tolower, 1},
|
|
{jid_remove_resource, 1},
|
|
{jid_replace_resource, 2}]).
|
|
|
|
-include("ejabberd.hrl").
|
|
-include("jlib.hrl").
|
|
|
|
%send_iq(From, To, ID, SubTags) ->
|
|
% ok.
|
|
|
|
-spec make_result_iq_reply(xmlel()) -> xmlel().
|
|
|
|
make_result_iq_reply(#xmlel{name = Name, attrs = Attrs,
|
|
children = SubTags}) ->
|
|
NewAttrs = make_result_iq_reply_attrs(Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs,
|
|
children = SubTags}.
|
|
|
|
-spec make_result_iq_reply_attrs([attr()]) -> [attr()].
|
|
|
|
make_result_iq_reply_attrs(Attrs) ->
|
|
To = fxml:get_attr(<<"to">>, Attrs),
|
|
From = fxml: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.
|
|
|
|
-spec make_error_reply(xmlel(), binary(), binary()) -> xmlel().
|
|
|
|
make_error_reply(#xmlel{name = Name, attrs = Attrs,
|
|
children = SubTags},
|
|
Code, Desc) ->
|
|
NewAttrs = make_error_reply_attrs(Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs,
|
|
children =
|
|
SubTags ++
|
|
[#xmlel{name = <<"error">>,
|
|
attrs = [{<<"code">>, Code}],
|
|
children = [{xmlcdata, Desc}]}]}.
|
|
|
|
-spec make_error_reply(xmlel(), xmlel()) -> xmlel().
|
|
|
|
make_error_reply(#xmlel{name = Name, attrs = Attrs,
|
|
children = SubTags},
|
|
Error) ->
|
|
NewAttrs = make_error_reply_attrs(Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs,
|
|
children = SubTags ++ [Error]}.
|
|
|
|
-spec make_error_reply_attrs([attr()]) -> [attr()].
|
|
|
|
make_error_reply_attrs(Attrs) ->
|
|
To = fxml:get_attr(<<"to">>, Attrs),
|
|
From = fxml: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.
|
|
|
|
-spec make_error_element(binary(), binary()) -> xmlel().
|
|
|
|
make_error_element(Code, Desc) ->
|
|
#xmlel{name = <<"error">>, attrs = [{<<"code">>, Code}],
|
|
children = [{xmlcdata, Desc}]}.
|
|
|
|
-spec make_correct_from_to_attrs(binary(), binary(), [attr()]) -> [attr()].
|
|
|
|
make_correct_from_to_attrs(From, To, Attrs) ->
|
|
Attrs1 = lists:keydelete(<<"from">>, 1, Attrs),
|
|
Attrs2 = case fxml:get_attr(<<"to">>, Attrs) of
|
|
{value, _} -> Attrs1;
|
|
_ -> [{<<"to">>, To} | Attrs1]
|
|
end,
|
|
Attrs3 = [{<<"from">>, From} | Attrs2],
|
|
Attrs3.
|
|
|
|
-spec replace_from_to_attrs(binary(), binary(), [attr()]) -> [attr()].
|
|
|
|
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.
|
|
|
|
-spec replace_from_to(jid(), jid(), xmlel()) -> xmlel().
|
|
|
|
replace_from_to(From, To,
|
|
#xmlel{name = Name, attrs = Attrs, children = Els}) ->
|
|
NewAttrs =
|
|
replace_from_to_attrs(jid:to_string(From),
|
|
jid:to_string(To), Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs, children = Els}.
|
|
|
|
-spec replace_from_attrs(binary(), [attr()]) -> [attr()].
|
|
|
|
replace_from_attrs(From, Attrs) ->
|
|
Attrs1 = lists:keydelete(<<"from">>, 1, Attrs),
|
|
[{<<"from">>, From} | Attrs1].
|
|
|
|
-spec replace_from(jid(), xmlel()) -> xmlel().
|
|
|
|
replace_from(From,
|
|
#xmlel{name = Name, attrs = Attrs, children = Els}) ->
|
|
NewAttrs = replace_from_attrs(jid:to_string(From),
|
|
Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs, children = Els}.
|
|
|
|
-spec remove_attr(binary(), xmlel()) -> xmlel().
|
|
|
|
remove_attr(Attr,
|
|
#xmlel{name = Name, attrs = Attrs, children = Els}) ->
|
|
NewAttrs = lists:keydelete(Attr, 1, Attrs),
|
|
#xmlel{name = Name, attrs = NewAttrs, children = Els}.
|
|
|
|
-spec make_jid(binary(), binary(), binary()) -> jid() | error.
|
|
|
|
make_jid(User, Server, Resource) ->
|
|
jid:make(User, Server, Resource).
|
|
|
|
-spec make_jid({binary(), binary(), binary()}) -> jid() | error.
|
|
|
|
make_jid({User, Server, Resource}) ->
|
|
jid:make({User, Server, Resource}).
|
|
|
|
%% This is the reverse of make_jid/1
|
|
-spec split_jid(jid()) -> {binary(), binary(), binary()} | error.
|
|
split_jid(J) ->
|
|
jid:split(J).
|
|
|
|
-spec string_to_jid(binary()) -> jid() | error.
|
|
|
|
string_to_jid(S) ->
|
|
jid:from_string(S).
|
|
|
|
-spec jid_to_string(jid() | ljid()) -> binary().
|
|
|
|
jid_to_string(J) ->
|
|
jid:to_string(J).
|
|
|
|
-spec is_nodename(binary()) -> boolean().
|
|
|
|
is_nodename(Node) ->
|
|
jid:is_nodename(Node).
|
|
|
|
%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].
|
|
|
|
-spec tolower(binary()) -> binary().
|
|
|
|
tolower(B) ->
|
|
iolist_to_binary(tolower_s(binary_to_list(B))).
|
|
|
|
tolower_s([C | Cs]) ->
|
|
if C >= $A, C =< $Z -> [C + 32 | tolower_s(Cs)];
|
|
true -> [C | tolower_s(Cs)]
|
|
end;
|
|
tolower_s([]) -> [].
|
|
|
|
%tolower([C | Cs]) when C >= $A, C =< $Z ->
|
|
% [C + 32 | tolower(Cs)];
|
|
%tolower([C | Cs]) ->
|
|
% [C | tolower(Cs)];
|
|
%tolower([]) ->
|
|
% [].
|
|
|
|
-spec nodeprep(binary()) -> binary() | error.
|
|
|
|
nodeprep(S) -> jid:nodeprep(S).
|
|
|
|
-spec nameprep(binary()) -> binary() | error.
|
|
|
|
nameprep(S) -> jid:nameprep(S).
|
|
|
|
-spec resourceprep(binary()) -> binary() | error.
|
|
|
|
resourceprep(S) -> jid:resourceprep(S).
|
|
|
|
-spec jid_tolower(jid() | ljid()) -> error | ljid().
|
|
|
|
jid_tolower(J) ->
|
|
jid:tolower(J).
|
|
|
|
-spec jid_remove_resource(jid()) -> jid();
|
|
(ljid()) -> ljid().
|
|
|
|
jid_remove_resource(J) -> jid:remove_resource(J).
|
|
|
|
-spec jid_replace_resource(jid(), binary()) -> error | jid().
|
|
|
|
jid_replace_resource(JID, Resource) ->
|
|
jid:replace_resource(JID, Resource).
|
|
|
|
-spec get_iq_namespace(xmlel()) -> binary().
|
|
|
|
get_iq_namespace(#xmlel{name = <<"iq">>, children = Els}) ->
|
|
case fxml:remove_cdata(Els) of
|
|
[#xmlel{attrs = Attrs}] -> fxml:get_attr_s(<<"xmlns">>, Attrs);
|
|
_ -> <<"">>
|
|
end;
|
|
get_iq_namespace(_) -> <<"">>.
|
|
|
|
%%
|
|
-spec(iq_query_info/1 ::
|
|
(
|
|
Xmlel :: xmlel())
|
|
-> iq_request() | 'reply' | 'invalid' | 'not_iq'
|
|
).
|
|
|
|
%% @spec (xmlelement()) -> iq() | reply | invalid | not_iq
|
|
iq_query_info(El) -> iq_info_internal(El, request).
|
|
|
|
%%
|
|
-spec(iq_query_or_response_info/1 ::
|
|
(
|
|
Xmlel :: xmlel())
|
|
-> iq_request() | iq_reply() | 'reply' | 'invalid' | 'not_iq'
|
|
).
|
|
|
|
iq_query_or_response_info(El) ->
|
|
iq_info_internal(El, any).
|
|
|
|
iq_info_internal(#xmlel{name = <<"iq">>, attrs = Attrs, children = Els}, Filter) ->
|
|
ID = fxml:get_attr_s(<<"id">>, Attrs),
|
|
Lang = fxml:get_attr_s(<<"xml:lang">>, Attrs),
|
|
{Type, Class} = case fxml:get_attr_s(<<"type">>, Attrs) of
|
|
<<"set">> -> {set, request};
|
|
<<"get">> -> {get, request};
|
|
<<"result">> -> {result, reply};
|
|
<<"error">> -> {error, reply};
|
|
_ -> {invalid, invalid}
|
|
end,
|
|
if Type == invalid -> invalid; Class == request; Filter == any ->
|
|
FilteredEls = fxml:remove_cdata(Els),
|
|
{XMLNS, SubEl} = case {Class, FilteredEls} of
|
|
{request, [#xmlel{attrs = Attrs2}]} ->
|
|
{fxml:get_attr_s(<<"xmlns">>, Attrs2), hd(FilteredEls)};
|
|
{reply, _} ->
|
|
NonErrorEls = [El || #xmlel{name = SubName} = El <- FilteredEls,
|
|
SubName /= <<"error">>],
|
|
{case NonErrorEls of
|
|
[NonErrorEl] -> fxml:get_tag_attr_s(<<"xmlns">>, NonErrorEl);
|
|
_ -> <<"">>
|
|
end,
|
|
FilteredEls};
|
|
_ ->
|
|
{<<"">>, []}
|
|
end,
|
|
if XMLNS == <<"">>, Class == request ->
|
|
invalid;
|
|
true ->
|
|
#iq{id = ID, type = Type, xmlns = XMLNS, lang = Lang, sub_el = SubEl}
|
|
end;
|
|
Class == reply, Filter /= any ->
|
|
reply
|
|
end;
|
|
iq_info_internal(_, _) -> not_iq.
|
|
|
|
-spec is_iq_request_type(set | get | result | error) -> boolean().
|
|
|
|
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">>.
|
|
|
|
-spec(iq_to_xml/1 ::
|
|
(
|
|
IQ :: iq())
|
|
-> xmlel()
|
|
).
|
|
|
|
iq_to_xml(#iq{id = ID, type = Type, sub_el = SubEl}) ->
|
|
if ID /= <<"">> ->
|
|
#xmlel{name = <<"iq">>,
|
|
attrs =
|
|
[{<<"id">>, ID}, {<<"type">>, iq_type_to_string(Type)}],
|
|
children = SubEl};
|
|
true ->
|
|
#xmlel{name = <<"iq">>,
|
|
attrs = [{<<"type">>, iq_type_to_string(Type)}],
|
|
children = SubEl}
|
|
end.
|
|
|
|
-spec(parse_xdata_submit/1 ::
|
|
(
|
|
El :: xmlel())
|
|
-> [{Var::binary(), Values::[binary()]}]
|
|
%%
|
|
| 'invalid'
|
|
).
|
|
|
|
parse_xdata_submit(#xmlel{attrs = Attrs, children = Els}) ->
|
|
case fxml:get_attr_s(<<"type">>, Attrs) of
|
|
<<"submit">> ->
|
|
lists:reverse(parse_xdata_fields(Els, []));
|
|
<<"form">> -> %% This is a workaround to accept Psi's wrong forms
|
|
lists:reverse(parse_xdata_fields(Els, []));
|
|
_ ->
|
|
invalid
|
|
end.
|
|
|
|
-spec(parse_xdata_fields/2 ::
|
|
(
|
|
Xmlels :: [xmlel() | cdata()],
|
|
Res :: [{Var::binary(), Values :: [binary()]}])
|
|
-> [{Var::binary(), Values::[binary()]}]
|
|
).
|
|
|
|
parse_xdata_fields([], Res) -> Res;
|
|
parse_xdata_fields([#xmlel{name = <<"field">>, attrs = Attrs, children = SubEls}
|
|
| Els], Res) ->
|
|
case fxml: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) ->
|
|
parse_xdata_fields(Els, Res).
|
|
|
|
-spec(parse_xdata_values/2 ::
|
|
(
|
|
Xmlels :: [xmlel() | cdata()],
|
|
Res :: [binary()])
|
|
-> [binary()]
|
|
).
|
|
|
|
parse_xdata_values([], Res) -> Res;
|
|
parse_xdata_values([#xmlel{name = <<"value">>, children = SubEls} | Els], Res) ->
|
|
Val = fxml:get_cdata(SubEls),
|
|
parse_xdata_values(Els, [Val | Res]);
|
|
parse_xdata_values([_ | Els], Res) ->
|
|
parse_xdata_values(Els, Res).
|
|
|
|
-spec rsm_decode(iq() | xmlel()) -> none | rsm_in().
|
|
|
|
rsm_decode(#iq{sub_el = SubEl}) -> rsm_decode(SubEl);
|
|
rsm_decode(#xmlel{} = SubEl) ->
|
|
case fxml:get_subtag(SubEl, <<"set">>) of
|
|
false -> none;
|
|
#xmlel{name = <<"set">>, children = SubEls} ->
|
|
lists:foldl(fun rsm_parse_element/2, #rsm_in{}, SubEls)
|
|
end.
|
|
|
|
rsm_parse_element(#xmlel{name = <<"max">>, attrs = []} =
|
|
Elem,
|
|
RsmIn) ->
|
|
CountStr = fxml:get_tag_cdata(Elem),
|
|
{Count, _} = str:to_integer(CountStr),
|
|
RsmIn#rsm_in{max = Count};
|
|
rsm_parse_element(#xmlel{name = <<"before">>,
|
|
attrs = []} =
|
|
Elem,
|
|
RsmIn) ->
|
|
UID = fxml:get_tag_cdata(Elem),
|
|
RsmIn#rsm_in{direction = before, id = UID};
|
|
rsm_parse_element(#xmlel{name = <<"after">>,
|
|
attrs = []} =
|
|
Elem,
|
|
RsmIn) ->
|
|
UID = fxml:get_tag_cdata(Elem),
|
|
RsmIn#rsm_in{direction = aft, id = UID};
|
|
rsm_parse_element(#xmlel{name = <<"index">>,
|
|
attrs = []} =
|
|
Elem,
|
|
RsmIn) ->
|
|
IndexStr = fxml:get_tag_cdata(Elem),
|
|
{Index, _} = str:to_integer(IndexStr),
|
|
RsmIn#rsm_in{index = Index};
|
|
rsm_parse_element(_, RsmIn) -> RsmIn.
|
|
|
|
-spec rsm_encode(iq(), rsm_out()) -> iq().
|
|
|
|
rsm_encode(#iq{sub_el = SubEl} = IQ, RsmOut) ->
|
|
Set = #xmlel{name = <<"set">>,
|
|
attrs = [{<<"xmlns">>, ?NS_RSM}],
|
|
children = lists:reverse(rsm_encode_out(RsmOut))},
|
|
#xmlel{name = Name, attrs = Attrs, children = SubEls} =
|
|
SubEl,
|
|
New = #xmlel{name = Name, attrs = Attrs,
|
|
children = [Set | SubEls]},
|
|
IQ#iq{sub_el = New}.
|
|
|
|
-spec rsm_encode(none | rsm_out()) -> [xmlel()].
|
|
|
|
rsm_encode(none) -> [];
|
|
rsm_encode(RsmOut) ->
|
|
[#xmlel{name = <<"set">>,
|
|
attrs = [{<<"xmlns">>, ?NS_RSM}],
|
|
children = lists:reverse(rsm_encode_out(RsmOut))}].
|
|
|
|
rsm_encode_out(#rsm_out{count = Count, index = Index,
|
|
first = First, last = Last}) ->
|
|
El = rsm_encode_first(First, Index, []),
|
|
El2 = rsm_encode_last(Last, El),
|
|
rsm_encode_count(Count, El2).
|
|
|
|
rsm_encode_first(undefined, undefined, Arr) -> Arr;
|
|
rsm_encode_first(First, undefined, Arr) ->
|
|
[#xmlel{name = <<"first">>, attrs = [],
|
|
children = [{xmlcdata, First}]}
|
|
| Arr];
|
|
rsm_encode_first(First, Index, Arr) ->
|
|
[#xmlel{name = <<"first">>,
|
|
attrs = [{<<"index">>, i2l(Index)}],
|
|
children = [{xmlcdata, First}]}
|
|
| Arr].
|
|
|
|
rsm_encode_last(undefined, Arr) -> Arr;
|
|
rsm_encode_last(Last, Arr) ->
|
|
[#xmlel{name = <<"last">>, attrs = [],
|
|
children = [{xmlcdata, Last}]}
|
|
| Arr].
|
|
|
|
rsm_encode_count(undefined, Arr) -> Arr;
|
|
rsm_encode_count(Count, Arr) ->
|
|
[#xmlel{name = <<"count">>, attrs = [],
|
|
children = [{xmlcdata, i2l(Count)}]}
|
|
| Arr].
|
|
|
|
-spec is_standalone_chat_state(xmlel()) -> boolean().
|
|
|
|
is_standalone_chat_state(#xmlel{name = <<"message">>} = El) ->
|
|
ChatStates = [<<"active">>, <<"inactive">>, <<"gone">>, <<"composing">>,
|
|
<<"paused">>],
|
|
Stripped =
|
|
lists:foldl(fun(ChatState, AccEl) ->
|
|
fxml:remove_subtags(AccEl, ChatState,
|
|
{<<"xmlns">>, ?NS_CHATSTATES})
|
|
end, El, ChatStates),
|
|
case Stripped of
|
|
#xmlel{children = [#xmlel{name = <<"thread">>}]} ->
|
|
true;
|
|
#xmlel{children = []} ->
|
|
true;
|
|
_ ->
|
|
false
|
|
end;
|
|
is_standalone_chat_state(_El) -> false.
|
|
|
|
-spec add_delay_info(xmlel(), jid() | ljid() | binary(), erlang:timestamp())
|
|
-> xmlel().
|
|
|
|
add_delay_info(El, From, Time) ->
|
|
add_delay_info(El, From, Time, <<"">>).
|
|
|
|
-spec add_delay_info(xmlel(), jid() | ljid() | binary(), erlang:timestamp(),
|
|
binary()) -> xmlel().
|
|
|
|
add_delay_info(El, From, Time, Desc) ->
|
|
case fxml:get_subtag_with_xmlns(El, <<"delay">>, ?NS_DELAY) of
|
|
false ->
|
|
%% Add new tag
|
|
DelayTag = create_delay_tag(Time, From, Desc),
|
|
fxml:append_subtags(El, [DelayTag]);
|
|
DelayTag ->
|
|
%% Update existing tag
|
|
NewDelayTag =
|
|
case {fxml:get_tag_cdata(DelayTag), Desc} of
|
|
{<<"">>, <<"">>} ->
|
|
DelayTag;
|
|
{OldDesc, <<"">>} ->
|
|
DelayTag#xmlel{children = [{xmlcdata, OldDesc}]};
|
|
{<<"">>, NewDesc} ->
|
|
DelayTag#xmlel{children = [{xmlcdata, NewDesc}]};
|
|
{OldDesc, NewDesc} ->
|
|
case binary:match(OldDesc, NewDesc) of
|
|
nomatch ->
|
|
FinalDesc = <<OldDesc/binary, ", ", NewDesc/binary>>,
|
|
DelayTag#xmlel{children = [{xmlcdata, FinalDesc}]};
|
|
_ ->
|
|
DelayTag#xmlel{children = [{xmlcdata, OldDesc}]}
|
|
end
|
|
end,
|
|
NewEl = fxml:remove_subtags(El, <<"delay">>, {<<"xmlns">>, ?NS_DELAY}),
|
|
fxml:append_subtags(NewEl, [NewDelayTag])
|
|
end.
|
|
|
|
-spec create_delay_tag(erlang:timestamp(), jid() | ljid() | binary(), binary())
|
|
-> xmlel() | error.
|
|
|
|
create_delay_tag(TimeStamp, FromJID, Desc) when is_tuple(FromJID) ->
|
|
From = jid:to_string(FromJID),
|
|
Stamp = now_to_utc_string(TimeStamp, 3),
|
|
Children = case Desc of
|
|
<<"">> -> [];
|
|
_ -> [{xmlcdata, Desc}]
|
|
end,
|
|
#xmlel{name = <<"delay">>,
|
|
attrs =
|
|
[{<<"xmlns">>, ?NS_DELAY}, {<<"from">>, From},
|
|
{<<"stamp">>, Stamp}],
|
|
children = Children};
|
|
create_delay_tag(DateTime, Host, Desc) when is_binary(Host) ->
|
|
FromJID = jid:make(<<"">>, Host, <<"">>),
|
|
create_delay_tag(DateTime, FromJID, Desc).
|
|
|
|
-type tz() :: {binary(), {integer(), integer()}} | {integer(), integer()} | utc.
|
|
|
|
%% Timezone = utc | {Sign::string(), {Hours, Minutes}} | {Hours, Minutes}
|
|
%% Hours = integer()
|
|
%% Minutes = integer()
|
|
-spec timestamp_to_iso(calendar:datetime(), tz()) -> {binary(), binary()}.
|
|
|
|
%% This is the XEP-0082 date and time format
|
|
%% http://xmpp.org/extensions/xep-0082.html
|
|
|
|
timestamp_to_iso({{Year, Month, Day},
|
|
{Hour, Minute, Second}},
|
|
Timezone) ->
|
|
Timestamp_string =
|
|
lists:flatten(io_lib:format("~4..0B-~2..0B-~2..0BT~2..0B:~2..0B:~2..0B",
|
|
[Year, Month, Day, Hour, Minute, Second])),
|
|
Timezone_string = case Timezone of
|
|
utc -> "Z";
|
|
{Sign, {TZh, TZm}} ->
|
|
io_lib:format("~s~2..0B:~2..0B", [Sign, TZh, TZm]);
|
|
{TZh, TZm} ->
|
|
Sign = case TZh >= 0 of
|
|
true -> "+";
|
|
false -> "-"
|
|
end,
|
|
io_lib:format("~s~2..0B:~2..0B",
|
|
[Sign, abs(TZh), TZm])
|
|
end,
|
|
{iolist_to_binary(Timestamp_string), iolist_to_binary(Timezone_string)}.
|
|
|
|
|
|
-spec timestamp_to_legacy(calendar:datetime()) -> binary().
|
|
%% This is the jabber legacy format
|
|
%% http://xmpp.org/extensions/xep-0091.html#time
|
|
timestamp_to_legacy({{Year, Month, Day},
|
|
{Hour, Minute, Second}}) ->
|
|
iolist_to_binary(io_lib:format("~4..0B~2..0B~2..0BT~2..0B:~2..0B:~2..0B",
|
|
[Year, Month, Day, Hour, Minute, Second])).
|
|
|
|
-spec timestamp_to_iso_basic(calendar:datetime()) -> binary().
|
|
%% This is the ISO 8601 basic bormat
|
|
timestamp_to_iso_basic({{Year, Month, Day},
|
|
{Hour, Minute, Second}}) ->
|
|
iolist_to_binary(io_lib:format("~4..0B~2..0B~2..0BT~2..0B~2..0B~2..0B",
|
|
[Year, Month, Day, Hour, Minute, Second])).
|
|
|
|
-spec now_to_utc_string(erlang:timestamp()) -> binary().
|
|
|
|
now_to_utc_string({MegaSecs, Secs, MicroSecs}) ->
|
|
now_to_utc_string({MegaSecs, Secs, MicroSecs}, 6).
|
|
|
|
-spec now_to_utc_string(erlang:timestamp(), 1..6) -> binary().
|
|
|
|
now_to_utc_string({MegaSecs, Secs, MicroSecs}, Precision) ->
|
|
{{Year, Month, Day}, {Hour, Minute, Second}} =
|
|
calendar:now_to_universal_time({MegaSecs, Secs,
|
|
MicroSecs}),
|
|
Max = round(math:pow(10, Precision)),
|
|
case round(MicroSecs / math:pow(10, 6 - Precision)) of
|
|
Max ->
|
|
now_to_utc_string({MegaSecs, Secs + 1, 0}, Precision);
|
|
FracOfSec ->
|
|
list_to_binary(io_lib:format("~4..0B-~2..0B-~2..0BT"
|
|
"~2..0B:~2..0B:~2..0B.~*..0BZ",
|
|
[Year, Month, Day, Hour, Minute, Second,
|
|
Precision, FracOfSec]))
|
|
end.
|
|
|
|
-spec now_to_local_string(erlang:timestamp()) -> binary().
|
|
|
|
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,
|
|
list_to_binary(io_lib:format("~4..0B-~2..0B-~2..0BT~2..0B:~2..0B:~2..0B.~6."
|
|
".0B~s~2..0B:~2..0B",
|
|
[Year, Month, Day, Hour, Minute, Second,
|
|
MicroSecs, Sign, H, M])).
|
|
|
|
-spec datetime_string_to_timestamp(binary()) -> undefined | erlang:timestamp().
|
|
|
|
datetime_string_to_timestamp(TimeStr) ->
|
|
case catch parse_datetime(TimeStr) of
|
|
{'EXIT', _Err} -> undefined;
|
|
TimeStamp -> TimeStamp
|
|
end.
|
|
|
|
parse_datetime(TimeStr) ->
|
|
[Date, Time] = str: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] = str:tokens(Date, <<"-">>),
|
|
Date1 = {binary_to_integer(Y), binary_to_integer(M),
|
|
binary_to_integer(D)},
|
|
case calendar:valid_date(Date1) of
|
|
true -> Date1;
|
|
_ -> false
|
|
end.
|
|
|
|
% hh:mm:ss[.sss]TZD
|
|
parse_time(Time) ->
|
|
case str:str(Time, <<"Z">>) of
|
|
0 -> parse_time_with_timezone(Time);
|
|
_ ->
|
|
[T | _] = str:tokens(Time, <<"Z">>),
|
|
{TT, MS} = parse_time1(T),
|
|
{TT, MS, 0, 0}
|
|
end.
|
|
|
|
parse_time_with_timezone(Time) ->
|
|
case str:str(Time, <<"+">>) of
|
|
0 ->
|
|
case str: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] = str: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] = str:tokens(TZ, <<":">>),
|
|
{[H1, M1], true} = check_list([{H, 12}, {M, 60}]),
|
|
{H1, M1}.
|
|
|
|
parse_time1(Time) ->
|
|
[HMS | T] = str:tokens(Time, <<".">>),
|
|
MS = case T of
|
|
[] -> 0;
|
|
[Val] -> binary_to_integer(str:left(Val, 6, $0))
|
|
end,
|
|
[H, M, S] = str: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 = binary_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)
|
|
%
|
|
|
|
-spec term_to_base64(term()) -> binary().
|
|
|
|
term_to_base64(Term) ->
|
|
encode_base64(term_to_binary(Term)).
|
|
|
|
-spec base64_to_term(binary()) -> {term, term()} | error.
|
|
|
|
base64_to_term(Base64) ->
|
|
case catch binary_to_term(decode_base64(Base64), [safe]) of
|
|
{'EXIT', _} ->
|
|
error;
|
|
Term ->
|
|
{term, Term}
|
|
end.
|
|
|
|
-spec decode_base64(binary()) -> binary().
|
|
|
|
decode_base64(S) ->
|
|
case catch binary:last(S) of
|
|
C when C == $\n; C == $\s ->
|
|
decode_base64(binary:part(S, 0, byte_size(S) - 1));
|
|
_ ->
|
|
decode_base64_bin(S, <<>>)
|
|
end.
|
|
|
|
take_without_spaces(Bin, Count) ->
|
|
take_without_spaces(Bin, Count, <<>>).
|
|
|
|
take_without_spaces(Bin, 0, Acc) ->
|
|
{Acc, Bin};
|
|
take_without_spaces(<<>>, _, Acc) ->
|
|
{Acc, <<>>};
|
|
take_without_spaces(<<$\s, Tail/binary>>, Count, Acc) ->
|
|
take_without_spaces(Tail, Count, Acc);
|
|
take_without_spaces(<<$\t, Tail/binary>>, Count, Acc) ->
|
|
take_without_spaces(Tail, Count, Acc);
|
|
take_without_spaces(<<$\n, Tail/binary>>, Count, Acc) ->
|
|
take_without_spaces(Tail, Count, Acc);
|
|
take_without_spaces(<<$\r, Tail/binary>>, Count, Acc) ->
|
|
take_without_spaces(Tail, Count, Acc);
|
|
take_without_spaces(<<Char:8, Tail/binary>>, Count, Acc) ->
|
|
take_without_spaces(Tail, Count-1, <<Acc/binary, Char:8>>).
|
|
|
|
decode_base64_bin(<<>>, Acc) ->
|
|
Acc;
|
|
decode_base64_bin(Bin, Acc) ->
|
|
case take_without_spaces(Bin, 4) of
|
|
{<<A, B, $=, $=>>, _} ->
|
|
<<Acc/binary, (d(A)):6, (d(B) bsr 4):2>>;
|
|
{<<A, B, C, $=>>, _} ->
|
|
<<Acc/binary, (d(A)):6, (d(B)):6, (d(C) bsr 2):4>>;
|
|
{<<A, B, C, D>>, Tail} ->
|
|
Acc2 = <<Acc/binary, (d(A)):6, (d(B)):6, (d(C)):6, (d(D)):6>>,
|
|
decode_base64_bin(Tail, Acc2);
|
|
_ ->
|
|
<<"">>
|
|
end.
|
|
|
|
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.
|
|
|
|
|
|
%% Convert Erlang inet IP to list
|
|
-spec encode_base64(binary()) -> binary().
|
|
|
|
encode_base64(Data) ->
|
|
encode_base64_bin(Data, <<>>).
|
|
|
|
encode_base64_bin(<<A:6, B:6, C:6, D:6, Tail/binary>>, Acc) ->
|
|
encode_base64_bin(Tail, <<Acc/binary, (e(A)):8, (e(B)):8, (e(C)):8, (e(D)):8>>);
|
|
encode_base64_bin(<<A:6, B:6, C:4>>, Acc) ->
|
|
<<Acc/binary, (e(A)):8, (e(B)):8, (e(C bsl 2)):8, $=>>;
|
|
encode_base64_bin(<<A:6, B:2>>, Acc) ->
|
|
<<Acc/binary, (e(A)):8, (e(B bsl 4)):8, $=, $=>>;
|
|
encode_base64_bin(<<>>, Acc) ->
|
|
Acc.
|
|
|
|
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}).
|
|
|
|
-spec ip_to_list(inet:ip_address() | undefined |
|
|
{inet:ip_address(), inet:port_number()}) -> binary().
|
|
|
|
ip_to_list({IP, _Port}) ->
|
|
ip_to_list(IP);
|
|
%% This function clause could use inet_parse too:
|
|
ip_to_list(undefined) ->
|
|
<<"unknown">>;
|
|
ip_to_list(IP) ->
|
|
list_to_binary(inet_parse:ntoa(IP)).
|
|
|
|
binary_to_atom(Bin) ->
|
|
erlang:binary_to_atom(Bin, utf8).
|
|
|
|
binary_to_integer(Bin) ->
|
|
erlang:binary_to_integer(Bin).
|
|
|
|
binary_to_integer(Bin, Base) ->
|
|
erlang:binary_to_integer(Bin, Base).
|
|
|
|
integer_to_binary(I) ->
|
|
erlang:integer_to_binary(I).
|
|
|
|
integer_to_binary(I, Base) ->
|
|
erlang:integer_to_binary(I, Base).
|
|
|
|
tuple_to_binary(T) ->
|
|
iolist_to_binary(tuple_to_list(T)).
|
|
|
|
atom_to_binary(A) ->
|
|
erlang:atom_to_binary(A, utf8).
|
|
|
|
|
|
l2i(I) when is_integer(I) -> I;
|
|
l2i(L) when is_binary(L) -> binary_to_integer(L).
|
|
|
|
i2l(I) when is_integer(I) -> integer_to_binary(I);
|
|
i2l(L) when is_binary(L) -> L.
|
|
|
|
i2l(I, N) when is_integer(I) -> i2l(i2l(I), N);
|
|
i2l(L, N) when is_binary(L) ->
|
|
case str:len(L) of
|
|
N -> L;
|
|
C when C > N -> L;
|
|
_ -> i2l(<<$0, L/binary>>, N)
|
|
end.
|
|
|
|
-spec queue_drop_while(fun((term()) -> boolean()), ?TQUEUE) -> ?TQUEUE.
|
|
|
|
queue_drop_while(F, Q) ->
|
|
case queue:peek(Q) of
|
|
{value, Item} ->
|
|
case F(Item) of
|
|
true ->
|
|
queue_drop_while(F, queue:drop(Q));
|
|
_ ->
|
|
Q
|
|
end;
|
|
empty ->
|
|
Q
|
|
end.
|