Chapril/xmpp.chapril.org-ejabberd
24
1
Fork 0
mirror of https://github.com/processone/ejabberd.git synced 2024-06-20 22:22:09 +02:00
Code Releases Activity
12a8d915cd
xmpp.chapril.org-ejabberd/src/jlib.erl
Holger Weiss b79f09d0eb Match namespace when checking for chat states 
When checking for standalone chat states, match the namespace rather
than the names of the elements defined in the current XEP-0085 revision.
2016-04-24 17:16:28 +02:00

922 lines
27 KiB
Erlang
Raw Blame History

%%%----------------------------------------------------------------------
%%% 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">>, children = Els}) ->
Stripped = [El || #xmlel{name = Name, attrs = Attrs} = El <- Els,
fxml:get_attr_s(<<"xmlns">>, Attrs) /= ?NS_CHATSTATES,
Name /= <<"thread">>],
Stripped == [];
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.
View Git Blame Copy Permalink