+2004-04-10 Alexey Shchepin <alexey@sevcom.net>
+
+ * src/idna.erl: Support for IDNA (RFC3490)
+ * src/ejabberd_s2s_out.erl: Likewise
+
+2004-04-03 Alexey Shchepin <alexey@sevcom.net>
+
+ * 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 <alexey@sevcom.net>
* (all): Updated win32 stuff (thanks to Sergei Golovan)
%%----------------------------------------------------------------------
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} ->
--- /dev/null
+%%%----------------------------------------------------------------------
+%%% File : idna.erl
+%%% Author : Alexey Shchepin <alexey@sevcom.net>
+%%% Purpose : Support for IDNA (RFC3490)
+%%% Created : 10 Apr 2004 by Alexey Shchepin <alexey@sevcom.net>
+%%% 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.
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}.
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))
- ++ "</" ++ Name ++ ">";
- 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))
+% ++ "</" ++ Name ++ ">";
+% 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) ->
%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
projects / ejabberd / commitdiff