diff --git a/ChangeLog b/ChangeLog index 0de59dd95..c712bceb8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2004-04-10 Alexey Shchepin + + * src/idna.erl: Support for IDNA (RFC3490) + * src/ejabberd_s2s_out.erl: Likewise + +2004-04-03 Alexey Shchepin + + * src/xml.erl: element_to_string/1 and crypt/1 now returns deep + list + * src/mod_muc/mod_muc_room.erl (add_message_to_history): Replaced + string:len with lists:flatlength + 2004-03-21 Alexey Shchepin * (all): Updated win32 stuff (thanks to Sergei Golovan) diff --git a/src/ejabberd_s2s_out.erl b/src/ejabberd_s2s_out.erl index 660a56779..07b976266 100644 --- a/src/ejabberd_s2s_out.erl +++ b/src/ejabberd_s2s_out.erl @@ -108,14 +108,18 @@ init([From, Server, Type]) -> %%---------------------------------------------------------------------- open_socket(init, StateData) -> {Addr, Port} = get_addr_port(StateData#state.server), - ?DEBUG("s2s_out: connecting to ~s:~p~n", [Addr, Port]), - Res = case gen_tcp:connect(Addr, Port, - [binary, {packet, 0}]) of - {ok, _Socket} = R -> R; - {error, Reason1} -> - ?DEBUG("s2s_out: connect return ~p~n", [Reason1]), - catch gen_tcp:connect(Addr, Port, - [binary, {packet, 0}, inet6]) + Res = case idna:domain_utf8_to_ascii(Addr) of + false -> {error, badarg}; + ASCIIAddr -> + ?DEBUG("s2s_out: connecting to ~s:~p~n", [ASCIIAddr, Port]), + case gen_tcp:connect(ASCIIAddr, Port, + [binary, {packet, 0}]) of + {ok, _Socket} = R -> R; + {error, Reason1} -> + ?DEBUG("s2s_out: connect return ~p~n", [Reason1]), + catch gen_tcp:connect(Addr, Port, + [binary, {packet, 0}, inet6]) + end end, case Res of {ok, Socket} -> diff --git a/src/idna.erl b/src/idna.erl new file mode 100644 index 000000000..cba1dbc93 --- /dev/null +++ b/src/idna.erl @@ -0,0 +1,179 @@ +%%%---------------------------------------------------------------------- +%%% File : idna.erl +%%% Author : Alexey Shchepin +%%% Purpose : Support for IDNA (RFC3490) +%%% Created : 10 Apr 2004 by Alexey Shchepin +%%% Id : $Id$ +%%%---------------------------------------------------------------------- + +-module(idna). +-author('alexey@sevcom.net'). +-vsn('$Revision$ '). + +%-compile(export_all). +-export([domain_utf8_to_ascii/1, + domain_ucs2_to_ascii/1]). + + +domain_utf8_to_ascii(Domain) -> + domain_ucs2_to_ascii(utf8_to_ucs2(Domain)). + +utf8_to_ucs2(S) -> + utf8_to_ucs2(S, ""). + +utf8_to_ucs2([], R) -> + lists:reverse(R); +utf8_to_ucs2([C | S], R) when C < 16#80 -> + utf8_to_ucs2(S, [C | R]); +utf8_to_ucs2([C1, C2 | S], R) when C1 < 16#E0 -> + utf8_to_ucs2(S, [((C1 band 16#1F) bsl 6) bor + (C2 band 16#3F) | R]); +utf8_to_ucs2([C1, C2, C3 | S], R) when C1 < 16#F0 -> + utf8_to_ucs2(S, [((C1 band 16#0F) bsl 12) bor + ((C2 band 16#3F) bsl 6) bor + (C3 band 16#3F) | R]). + + +domain_ucs2_to_ascii(Domain) -> + case catch domain_ucs2_to_ascii1(Domain) of + {'EXIT', _Reason} -> + false; + Res -> + Res + end. + +domain_ucs2_to_ascii1(Domain) -> + Parts = string:tokens(Domain, [16#002E, 16#3002, 16#FF0E, 16#FF61]), + ASCIIParts = lists:map(fun(P) -> + to_ascii(P) + end, Parts), + string:strip(lists:flatmap(fun(P) -> [$. | P] end, ASCIIParts), + left, $.). + +% Domain names are already nameprep'ed in ejabberd, so we skiping this step +to_ascii(Name) -> + false = lists:any( + fun(C) when + ( 0 =< C) and (C =< 16#2C) or + (16#2E =< C) and (C =< 16#2F) or + (16#3A =< C) and (C =< 16#40) or + (16#5B =< C) and (C =< 16#60) or + (16#7B =< C) and (C =< 16#7F) -> + true; + (_) -> + false + end, Name), + case Name of + [H | _] when H /= $- -> + true = lists:last(Name) /= $- + end, + ASCIIName = case lists:any(fun(C) -> C > 16#7F end, Name) of + true -> + true = case Name of + "xn--" ++ _ -> false; + _ -> true + end, + "xn--" ++ punycode_encode(Name); + false -> + Name + end, + L = length(ASCIIName), + true = (1 =< L) and (L =< 63), + ASCIIName. + + +%%% PUNYCODE (RFC3492) + +-define(BASE, 36). +-define(TMIN, 1). +-define(TMAX, 26). +-define(SKEW, 38). +-define(DAMP, 700). +-define(INITIAL_BIAS, 72). +-define(INITIAL_N, 128). + +punycode_encode(Input) -> + N = ?INITIAL_N, + Delta = 0, + Bias = ?INITIAL_BIAS, + Basic = lists:filter(fun(C) -> C =< 16#7f end, Input), + NonBasic = lists:filter(fun(C) -> C > 16#7f end, Input), + L = length(Input), + B = length(Basic), + SNonBasic = lists:usort(NonBasic), + Output1 = if + B > 0 -> Basic ++ "-"; + true -> "" + end, + Output2 = punycode_encode1(Input, SNonBasic, B, B, L, N, Delta, Bias, ""), + Output1 ++ Output2. + + +punycode_encode1(Input, [M | SNonBasic], B, H, L, N, Delta, Bias, Out) + when H < L -> + Delta1 = Delta + (M - N) * (H + 1), + % let n = m + {NewDelta, NewBias, NewH, NewOut} = + lists:foldl( + fun(C, {ADelta, ABias, AH, AOut}) -> + if + C < M -> + {ADelta + 1, ABias, AH, AOut}; + C == M -> + NewOut = punycode_encode_delta(ADelta, ABias, AOut), + NewBias = adapt(ADelta, H + 1, H == B), + {0, NewBias, AH + 1, NewOut}; + true -> + {ADelta, ABias, AH, AOut} + end + end, {Delta1, Bias, H, Out}, Input), + punycode_encode1( + Input, SNonBasic, B, NewH, L, M + 1, NewDelta + 1, NewBias, NewOut); + +punycode_encode1(Input, SNonBasic, B, H, L, N, Delta, Bias, Out) -> + lists:reverse(Out). + + +punycode_encode_delta(Delta, Bias, Out) -> + punycode_encode_delta(Delta, Bias, Out, ?BASE). + +punycode_encode_delta(Delta, Bias, Out, K) -> + T = if + K =< Bias -> ?TMIN; + K >= Bias + ?TMAX -> ?TMAX; + true -> K - Bias + end, + if + Delta < T -> + [codepoint(Delta) | Out]; + true -> + C = T + ((Delta - T) rem (?BASE - T)), + punycode_encode_delta((Delta - T) div (?BASE - T), Bias, + [codepoint(C) | Out], K + ?BASE) + end. + + +adapt(Delta, NumPoints, FirstTime) -> + Delta1 = if + FirstTime -> Delta div ?DAMP; + true -> Delta div 2 + end, + Delta2 = Delta1 + (Delta1 div NumPoints), + adapt1(Delta2, 0). + +adapt1(Delta, K) -> + if + Delta > ((?BASE - ?TMIN) * ?TMAX) div 2 -> + adapt1(Delta div (?BASE - ?TMIN), K + ?BASE); + true -> + K + (((?BASE - ?TMIN + 1) * Delta) div (Delta + ?SKEW)) + end. + + +codepoint(C) -> + if + (0 =< C) and (C =< 25) -> + C + 97; + (26 =< C) and (C =< 35) -> + C + 22 + end. diff --git a/src/mod_muc/mod_muc_room.erl b/src/mod_muc/mod_muc_room.erl index 47e25cf72..0d83361bb 100644 --- a/src/mod_muc/mod_muc_room.erl +++ b/src/mod_muc/mod_muc_room.erl @@ -1383,7 +1383,7 @@ add_message_to_history(FromNick, Packet, StateData) -> jlib:jid_replace_resource(StateData#state.jid, FromNick), StateData#state.jid, TSPacket), - Size = string:len(xml:element_to_string(SPacket)), + Size = lists:flatlength(xml:element_to_string(SPacket)), Q1 = lqueue_in({FromNick, TSPacket, HaveSubject, TimeStamp, Size}, StateData#state.history), StateData#state{history = Q1}. diff --git a/src/xml.erl b/src/xml.erl index e14f54c15..222e49b3e 100644 --- a/src/xml.erl +++ b/src/xml.erl @@ -20,26 +20,26 @@ get_path_s/2, replace_tag_attr/3]). -element_to_string(El) -> - case El of - {xmlelement, Name, Attrs, Els} -> - if length(Els) > 0 -> - "<" ++ Name ++ attrs_to_string(Attrs) ++ ">" ++ - lists:append( - lists:map(fun(E) -> element_to_string(E) end, Els)) - ++ ""; - true -> - "<" ++ Name ++ attrs_to_string(Attrs) ++ "/>" - end; - {xmlcdata, CData} -> crypt(CData) - end. - - -attrs_to_string(Attrs) -> - lists:append(lists:map(fun(A) -> attr_to_string(A) end, Attrs)). - -attr_to_string({Name, Value}) -> - " " ++ crypt(Name) ++ "='" ++ crypt(Value) ++ "'". +%element_to_string(El) -> +% case El of +% {xmlelement, Name, Attrs, Els} -> +% if length(Els) > 0 -> +% "<" ++ Name ++ attrs_to_string(Attrs) ++ ">" ++ +% lists:append( +% lists:map(fun(E) -> element_to_string(E) end, Els)) +% ++ ""; +% true -> +% "<" ++ Name ++ attrs_to_string(Attrs) ++ "/>" +% end; +% {xmlcdata, CData} -> crypt(CData) +% end. +% +% +%attrs_to_string(Attrs) -> +% lists:append(lists:map(fun(A) -> attr_to_string(A) end, Attrs)). +% +%attr_to_string({Name, Value}) -> +% " " ++ crypt(Name) ++ "='" ++ crypt(Value) ++ "'". %element_to_string2(El) -> @@ -64,25 +64,56 @@ attr_to_string({Name, Value}) -> %attr_to_list({Name, Value}) -> % [" ", crypt(Name), "='", crypt(Value), "'"]. +element_to_string(El) -> + case El of + {xmlelement, Name, Attrs, Els} -> + if + Els /= [] -> + [$<, Name, attrs_to_list(Attrs), $>, + [element_to_string(E) || E <- Els], + $<, $/, Name, $>]; + true -> + [$<, Name, attrs_to_list(Attrs), $/, $>] + end; + {xmlcdata, CData} -> + crypt(CData) + end. +attrs_to_list(Attrs) -> + [attr_to_list(A) || A <- Attrs]. + +attr_to_list({Name, Value}) -> + [$\s, crypt(Name), $=, $', crypt(Value), $']. + + + +%crypt(S) -> +% lists:reverse(crypt(S, "")). +% +%crypt([$& | S], R) -> +% crypt(S, [$;, $p, $m, $a, $& | R]); +%crypt([$< | S], R) -> +% crypt(S, [$;, $t, $l, $& | R]); +%crypt([$> | S], R) -> +% crypt(S, [$;, $t, $g, $& | R]); +%crypt([$" | S], R) -> +% crypt(S, [$;, $t, $o, $u, $q, $& | R]); +%crypt([$' | S], R) -> +% crypt(S, [$;, $s, $o, $p, $a, $& | R]); +%crypt([C | S], R) -> +% crypt(S, [C | R]); +%crypt([], R) -> +% R. crypt(S) -> - lists:reverse(crypt(S, "")). - -crypt([$& | S], R) -> - crypt(S, [$;, $p, $m, $a, $& | R]); -crypt([$< | S], R) -> - crypt(S, [$;, $t, $l, $& | R]); -crypt([$> | S], R) -> - crypt(S, [$;, $t, $g, $& | R]); -crypt([$" | S], R) -> - crypt(S, [$;, $t, $o, $u, $q, $& | R]); -crypt([$' | S], R) -> - crypt(S, [$;, $s, $o, $p, $a, $& | R]); -crypt([C | S], R) -> - crypt(S, [C | R]); -crypt([], R) -> - R. + [case C of + $& -> "&"; + $< -> "<"; + $> -> ">"; + $" -> """; + $' -> "'"; + _ -> C + end || C <- S]. %crypt1(S) -> % lists:flatten([case C of