%%%----------------------------------------------------------------------
%%% File : jlib.erl
%%% Author : Alexey Shchepin <alexey@sevcom.net>
%%% Purpose :
%%% Created : 23 Nov 2002 by Alexey Shchepin <alexey@sevcom.net>
%%% Id : $Id$
%%%----------------------------------------------------------------------
-module(jlib).
-author('alexey@sevcom.net').
-vsn('$Revision$ ').
-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,
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]).
-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({xmlelement, Name, Attrs, Els}) when Name == "iq" ->
ID = xml:get_attr_s("id", Attrs),
Type = xml:get_attr_s("type", Attrs),
Lang = xml:get_attr_s("xml:lang", Attrs),
Type1 = case Type of
"set" -> set;
"get" -> get;
"result" -> reply;
"error" -> reply;
_ -> invalid
end,
if
(Type1 /= invalid) and (Type1 /= reply) ->
case xml:remove_cdata(Els) of
[{xmlelement, Name2, Attrs2, Els2}] ->
XMLNS = xml:get_attr_s("xmlns", Attrs2),
if
XMLNS /= "" ->
#iq{id = ID,
type = Type1,
xmlns = XMLNS,
lang = Lang,
sub_el = {xmlelement, Name2, Attrs2, Els2}};
true ->
invalid
end;
_ ->
invalid
end;
true ->
Type1
end;
iq_query_info(_) ->
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}).
