Chapril/xmpp.chapril.org-ejabberd
25
1
Fork 0
mirror of https://github.com/processone/ejabberd.git synced 2024-12-24 17:29:28 +01:00
Code Releases Activity

WebSocket support update

Browse Source 
- added JSON encoding
- fix problem where session was not closed
- origin can now be decided by a custom module
This commit is contained in:
Eric Cestari 2011-01-19 14:54:20 +01:00
parent 1959546ff9
commit e380eee223
11 changed files with 2882 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/web/ejabberd_http.erl
View File

@ -340,7 +340,6 @@ process(Handlers, #ws{} = Ws)->
case (lists:prefix(HandlerPathPrefix, Ws#ws.path) or
(HandlerPathPrefix==Ws#ws.path)) of
true ->
?DEBUG("~p matches ~p", [Ws#ws.path, HandlerPathPrefix]),
LocalPath = lists:nthtail(length(HandlerPathPrefix), Ws#ws.path),
ejabberd_hooks:run(ws_debug, [{LocalPath, Ws}]),
Protocol = case lists:keysearch(protocol, 1, HandlerOpts) of
@ -351,9 +350,14 @@ process(Handlers, #ws{} = Ws)->
{value, {origins, O}} -> O;
false -> []
end,
Auth = case lists:keysearch(auth, 1, HandlerOpts) of
{value, {auth, A}} -> A;
false -> undefined
end,
WS2 = Ws#ws{local_path = LocalPath,
protocol=Protocol,
acceptable_origins=Origins},
acceptable_origins=Origins,
auth_module=Auth},
case ejabberd_websocket:is_acceptable(WS2) of
true ->
ejabberd_websocket:connect(WS2, HandlerModule);
@ -361,7 +365,6 @@ process(Handlers, #ws{} = Ws)->
process(HandlersLeft, Ws)
end;
false ->
?DEBUG("HandlersLeft : ~p ", [HandlersLeft]),
process(HandlersLeft, Ws)
end;
process(Handlers, Request) ->
@ -425,9 +428,10 @@ process_request(#state{request_method = Method,
{_, Origin} = lists:keyfind("Origin", 1, RequestHeaders),
Ws = #ws{socket = Socket,
sockmod = SockMod,
ws_autoexit = true,
ws_autoexit = false,
ip = IP,
path = LPath,
q = LQuery,
vsn = VSN,
host = Host,
port = Port,
@ -435,7 +439,6 @@ process_request(#state{request_method = Method,
headers = RequestHeaders
},
process(WebSocketHandlers, Ws),
?DEBUG("It is a websocket.",[]),
none;
false ->
Request = #request{method = Method,

4
src/web/ejabberd_http.hrl
View File

@ -47,6 +47,8 @@
path, % the websocket GET request path
headers, % [{Tag, Val}]
local_path,
q,
protocol,
acceptable_origins
acceptable_origins = [],
auth_module
}).

1294
src/web/ejabberd_http_bindjson.erl Normal file
View File

File diff suppressed because it is too large Load Diff

27
src/web/ejabberd_http_ws.erl
View File

@ -155,21 +155,22 @@ handle_sync_event({send, Packet}, _From, StateName, #state{ws = WS} = StateData)
true ->
list_to_binary(Packet)
end,
?DEBUG("sending on websocket : ~p ", [Packet2]),
%?DEBUG("sending on websocket : ~p ", [Packet2]),
WS:send(Packet2),
{reply, ok, StateName, StateData};
{reply, ok, StateName, StateData}.
handle_sync_event(close, _From, _StateName, StateData) ->
Reply = ok,
{stop, normal, Reply, StateData}.
handle_info(closed, _StateName, StateData) ->
{stop, normal, StateData};
handle_info({browser, Packet}, StateName, StateData)->
%?DEBUG("Received on websocket : ~p ", [Packet]),
NPacket = unicode:characters_to_binary(Packet,latin1),
NewState = case StateData#state.waiting_input of
false ->
Input = [StateData#state.input|Packet],
Input = [StateData#state.input|NPacket],
StateData#state{input = Input};
{Receiver, _Tag} ->
Receiver ! {tcp, StateData#state.socket,Packet},
Receiver ! {tcp, StateData#state.socket,NPacket},
cancel_timer(StateData#state.timer),
Timer = erlang:start_timer(StateData#state.timeout, self(), []),
StateData#state{waiting_input = false,
@ -190,7 +191,15 @@ handle_info(_, StateName, StateData) ->
code_change(_OldVsn, StateName, StateData, _Extra) ->
{ok, StateName, StateData}.
terminate(_Reason, _StateName, _StateData) -> ok.
terminate(_Reason, _StateName, StateData) ->
case StateData#state.waiting_input of
false ->
ok;
{Receiver,_} ->
?DEBUG("C2S Pid : ~p", [Receiver]),
Receiver ! {tcp_closed, StateData#state.socket }
end,
ok.
cancel_timer(Timer) ->
erlang:cancel_timer(Timer),
@ -199,4 +208,4 @@ cancel_timer(Timer) ->
ok
after 0 ->
ok
end.
end.

219
src/web/ejabberd_http_wsjson.erl Normal file
View File

@ -0,0 +1,219 @@
%%%----------------------------------------------------------------------
%%% File : ejabberd_websocket.erl
%%% Author : Eric Cestari <ecestari@process-one.net>
%%% Purpose : JSON - XMPP Websocket module support
%%% Created : 09-10-2010 by Eric Cestari <ecestari@process-one.net>
%%%
%%%
%%% ejabberd, Copyright (C) 2002-2010 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., 59 Temple Place, Suite 330, Boston, MA
%%% 02111-1307 USA
%%%
%%%----------------------------------------------------------------------
-module (ejabberd_http_wsjson).
-author('ecestari@process-one.net').
-behaviour(gen_fsm).
% External exports
-export([
start/1,
start_link/1,
init/1,
handle_event/3,
handle_sync_event/4,
code_change/4,
handle_info/3,
terminate/3,
send_xml/2,
setopts/2,
sockname/1, peername/1,
controlling_process/2,
become_controller/2,
close/1]).
-include("ejabberd.hrl").
-include("jlib.hrl").
-include("ejabberd_http.hrl").
-record(state, {
socket,
timeout,
timer,
input = [],
waiting_input = false, %% {ReceiverPid, Tag}
last_receiver,
ws}).
%-define(DBGFSM, true).
-ifdef(DBGFSM).
-define(FSMOPTS, [{debug, [trace]}]).
-else.
-define(FSMOPTS, []).
-endif.
-define(WEBSOCKET_TIMEOUT, 300000).
%
%
%%%%----------------------------------------------------------------------
%%%% API
%%%%----------------------------------------------------------------------
start(WS) ->
supervisor:start_child(ejabberd_wsloop_sup, [WS]).
start_link(WS) ->
gen_fsm:start_link(?MODULE, [WS],?FSMOPTS).
send_xml({http_ws, FsmRef, _IP}, Packet) ->
gen_fsm:sync_send_all_state_event(FsmRef, {send, Packet}).
setopts({http_ws, FsmRef, _IP}, Opts) ->
case lists:member({active, once}, Opts) of
true ->
gen_fsm:send_all_state_event(FsmRef, {activate, self()});
_ ->
ok
end.
sockname(_Socket) ->
{ok, {{0, 0, 0, 0}, 0}}.
peername({http_ws, _FsmRef, IP}) ->
{ok, IP}.
controlling_process(_Socket, _Pid) ->
ok.
become_controller(FsmRef, C2SPid) ->
gen_fsm:send_all_state_event(FsmRef, {become_controller, C2SPid}).
close({http_ws, FsmRef, _IP}) ->
catch gen_fsm:sync_send_all_state_event(FsmRef, close).
%%% Internal
init([WS]) ->
%% Read c2s options from the first ejabberd_c2s configuration in
%% the config file listen section
%% TODO: We should have different access and shaper values for
%% each connector. The default behaviour should be however to use
%% the default c2s restrictions if not defined for the current
%% connector.
Opts = [{xml_socket, true}|ejabberd_c2s_config:get_c2s_limits()],
WSTimeout = case ejabberd_config:get_local_option({websocket_timeout,
?MYNAME}) of
%% convert seconds of option into milliseconds
Int when is_integer(Int) -> Int*1000;
undefined -> ?WEBSOCKET_TIMEOUT
end,
Socket = {http_ws, self(), WS:get(ip)},
?DEBUG("Client connected through websocket ~p", [Socket]),
ejabberd_socket:start(ejabberd_c2s, ?MODULE, Socket, Opts),
Timer = erlang:start_timer(WSTimeout, self(), []),
{ok, loop, #state{
socket = Socket,
timeout = WSTimeout,
timer = Timer,
ws = WS}}.
handle_event({activate, From}, StateName, StateData) ->
case StateData#state.input of
[] ->
{next_state, StateName,
StateData#state{waiting_input = {From, ok}}};
Input ->
Receiver = From,
lists:reverse(lists:map(fun(Packet)->
Receiver ! {tcp, StateData#state.socket, [Packet]}
end, Input)),
{next_state, StateName, StateData#state{input = "",
waiting_input = false,
last_receiver = Receiver
}}
end.
handle_sync_event({send, Packet}, _From, StateName, #state{ws = WS} = StateData) ->
EJson = xmpp_json:to_json(Packet),
Json = mochijson2:encode(EJson),
WS:send(iolist_to_binary(Json)),
{reply, ok, StateName, StateData};
handle_sync_event(close, _From, _StateName, StateData) ->
Reply = ok,
{stop, normal, Reply, StateData}.
handle_info({browser, <<"\n">>}, StateName, StateData)->
NewState = case StateData#state.waiting_input of
false ->
ok;
{Receiver, _Tag} ->
Receiver ! {tcp, StateData#state.socket,<<"\n">>},
cancel_timer(StateData#state.timer),
Timer = erlang:start_timer(StateData#state.timeout, self(), []),
StateData#state{waiting_input = false,
last_receiver = Receiver,
timer = Timer}
end,
{next_state, StateName, NewState};
handle_info({browser, JsonPacket}, StateName, StateData)->
NewState = case StateData#state.waiting_input of
false ->
EJson = mochijson2:decode(JsonPacket),
Packet = xmpp_json:from_json(EJson),
Input = [Packet | StateData#state.input],
StateData#state{input = Input};
{Receiver, _Tag} ->
%?DEBUG("Received from browser : ~p", [JsonPacket]),
EJson = mochijson2:decode(JsonPacket),
%?DEBUG("decoded : ~p", [EJson]),
Packet = xmpp_json:from_json(EJson),
%?DEBUG("sending to c2s : ~p", [Packet]),
Receiver ! {tcp, StateData#state.socket,[Packet]},
cancel_timer(StateData#state.timer),
Timer = erlang:start_timer(StateData#state.timeout, self(), []),
StateData#state{waiting_input = false,
last_receiver = Receiver,
timer = Timer}
end,
{next_state, StateName, NewState};
handle_info({timeout, Timer, _}, _StateName,
#state{timer = Timer} = StateData) ->
{stop, normal, StateData};
handle_info(_, StateName, StateData) ->
{next_state, StateName, StateData}.
code_change(_OldVsn, StateName, StateData, _Extra) ->
{ok, StateName, StateData}.
terminate(_Reason, _StateName, _StateData) -> ok.
cancel_timer(Timer) ->
erlang:cancel_timer(Timer),
receive
{timeout, Timer, _} ->
ok
after 0 ->
ok
end.

39
src/web/ejabberd_websocket.erl
View File

@ -53,29 +53,30 @@ check(_Path, Headers)->
% If origins are set in configuration, check if it belongs
% If origins not set, access is open.
is_acceptable(#ws{origin=Origin, protocol=Protocol,
headers = Headers, acceptable_origins = Origins})->
headers = Headers, acceptable_origins = Origins, auth_module=undefined})->
ClientProtocol = lists:keyfind("Sec-WebSocket-Protocol",1, Headers),
case {(Origin == []) or lists:member(Origin, Origins), ClientProtocol, Protocol } of
case {(Origins == []) or lists:member(Origin, Origins), ClientProtocol, Protocol } of
{false, _, _} ->
?DEBUG("client does not come from authorized origin", []),
?INFO_MSG("client does not come from authorized origin", []),
false;
{_, false, _} ->
?DEBUG("Client did not ask for protocol", []),
true;
{_, {_, P}, P} ->
?DEBUG("Protocoles are matching", []),
true;
_ -> false
end.
_ = E->
?INFO_MSG("Wrong protocol requested : ~p", [E]),
false
end;
is_acceptable(#ws{local_path=LocalPath, origin=Origin, ip=IP, q=Q, protocol=Protocol, headers = Headers,auth_module=Module})->
Module:is_acceptable(LocalPath, Q, Origin, Protocol, IP, Headers).
% Connect and handshake with Websocket.
connect(#ws{vsn = Vsn, socket = Socket, origin=Origin, host=Host, port=Port, sockmod = SockMod, path = Path, headers = Headers, ws_autoexit = WsAutoExit} = Ws, WsLoop) ->
connect(#ws{vsn = Vsn, socket = Socket, q=Q,origin=Origin, host=Host, port=Port, sockmod = SockMod, path = Path, headers = Headers, ws_autoexit = WsAutoExit} = Ws, WsLoop) ->
% build handshake
HandshakeServer = handshake(Vsn, Socket,SockMod, Headers, {Path, Origin, Host, Port}),
HandshakeServer = handshake(Vsn, Socket,SockMod, Headers, {Path, Q, Origin, Host, Port}),
% send handshake back
%?DEBUG("building handshake response : ~p", [HandshakeServer]),
SockMod:send(Socket, HandshakeServer),
?DEBUG("Sent handshake response : ~p", [HandshakeServer]),
Ws0 = ejabberd_ws:new(Ws#ws{origin = Origin, host = Host}, self()),
%?DEBUG("Ws0 : ~p",[Ws0]),
% add data to ws record and spawn controlling process
@ -155,7 +156,7 @@ check_headers(Headers, RequiredHeaders) ->
% Function: List
% Description: Builds the server handshake response.
handshake({'draft-hixie', 0}, Sock,SocketMod, Headers, {Path, Origin, Host, Port}) ->
handshake({'draft-hixie', 0}, Sock,SocketMod, Headers, {Path, Q,Origin, Host, Port}) ->
% build data
{_, Key1} = lists:keyfind("Sec-Websocket-Key1",1, Headers),
{_, Key2} = lists:keyfind("Sec-Websocket-Key2",1, Headers),
@ -175,6 +176,16 @@ handshake({'draft-hixie', 0}, Sock,SocketMod, Headers, {Path, Origin, Host, Port
?ERROR_MSG("tcp error treating data: ~p", [_Other]),
<<>>
end,
QParams = lists:map(
fun({nokey,[]})->
none;
({K, V})->
K ++ "=" ++ V
end, Q),
QString = case QParams of
[none]-> "";
QParams-> "?" ++ string:join(QParams, "&")
end,
%?DEBUG("got content in body of websocket request: ~p, ~p", [Body,string:join([Host, Path],"/")]),
% prepare handhsake response
["HTTP/1.1 101 WebSocket Protocol Handshake\r\n",
@ -183,7 +194,7 @@ handshake({'draft-hixie', 0}, Sock,SocketMod, Headers, {Path, Origin, Host, Port
"Sec-WebSocket-Origin: ", Origin, "\r\n",
"Sec-WebSocket-Location: ws://",
string:join([Host, integer_to_list(Port)],":"),
"/",string:join(Path,"/") , "\r\n\r\n",
"/",string:join(Path,"/"),QString, "\r\n\r\n",
build_challenge({'draft-hixie', 0}, {Key1, Key2, Body})
];
handshake({'draft-hixie', 68}, _Sock,_SocketMod, _Headers, {Path, Origin, Host, Port}) ->
@ -232,7 +243,7 @@ ws_loop(Socket, Buffer, WsHandleLoopPid, SocketMode, WsAutoExit) ->
% close websocket and custom controlling loop
websocket_close(Socket, WsHandleLoopPid, SocketMode, WsAutoExit);
{send, Data} ->
?DEBUG("sending data to websocket: ~p", [Data]),
%?DEBUG("sending data to websocket: ~p", [Data]),
SocketMode:send(Socket, iolist_to_binary([0,Data,255])),
ws_loop(Socket, Buffer, WsHandleLoopPid, SocketMode, WsAutoExit);
shutdown ->

782
src/web/mochijson2.erl Normal file
View File

@ -0,0 +1,782 @@
%% @author Bob Ippolito <bob@mochimedia.com>
%% @copyright 2007 Mochi Media, Inc.
%% @doc Yet another JSON (RFC 4627) library for Erlang. mochijson2 works
%% with binaries as strings, arrays as lists (without an {array, _})
%% wrapper and it only knows how to decode UTF-8 (and ASCII).
-module(mochijson2).
-author('bob@mochimedia.com').
-export([encoder/1, encode/1]).
-export([decoder/1, decode/1]).
% This is a macro to placate syntax highlighters..
-define(Q, $\").
-define(ADV_COL(S, N), S#decoder{offset=N+S#decoder.offset,
column=N+S#decoder.column}).
-define(INC_COL(S), S#decoder{offset=1+S#decoder.offset,
column=1+S#decoder.column}).
-define(INC_LINE(S), S#decoder{offset=1+S#decoder.offset,
column=1,
line=1+S#decoder.line}).
-define(INC_CHAR(S, C),
case C of
$\n ->
S#decoder{column=1,
line=1+S#decoder.line,
offset=1+S#decoder.offset};
_ ->
S#decoder{column=1+S#decoder.column,
offset=1+S#decoder.offset}
end).
-define(IS_WHITESPACE(C),
(C =:= $\s orelse C =:= $\t orelse C =:= $\r orelse C =:= $\n)).
%% @type iolist() = [char() | binary() | iolist()]
%% @type iodata() = iolist() | binary()
%% @type json_string() = atom | binary()
%% @type json_number() = integer() | float()
%% @type json_array() = [json_term()]
%% @type json_object() = {struct, [{json_string(), json_term()}]}
%% @type json_iolist() = {json, iolist()}
%% @type json_term() = json_string() | json_number() | json_array() |
%% json_object() | json_iolist()
-record(encoder, {handler=null,
utf8=false}).
-record(decoder, {object_hook=null,
offset=0,
line=1,
column=1,
state=null}).
%% @spec encoder([encoder_option()]) -> function()
%% @doc Create an encoder/1 with the given options.
%% @type encoder_option() = handler_option() | utf8_option()
%% @type utf8_option() = boolean(). Emit unicode as utf8 (default - false)
encoder(Options) ->
State = parse_encoder_options(Options, #encoder{}),
fun (O) -> json_encode(O, State) end.
%% @spec encode(json_term()) -> iolist()
%% @doc Encode the given as JSON to an iolist.
encode(Any) ->
json_encode(Any, #encoder{}).
%% @spec decoder([decoder_option()]) -> function()
%% @doc Create a decoder/1 with the given options.
decoder(Options) ->
State = parse_decoder_options(Options, #decoder{}),
fun (O) -> json_decode(O, State) end.
%% @spec decode(iolist()) -> json_term()
%% @doc Decode the given iolist to Erlang terms.
decode(S) ->
json_decode(S, #decoder{}).
%% Internal API
parse_encoder_options([], State) ->
State;
parse_encoder_options([{handler, Handler} | Rest], State) ->
parse_encoder_options(Rest, State#encoder{handler=Handler});
parse_encoder_options([{utf8, Switch} | Rest], State) ->
parse_encoder_options(Rest, State#encoder{utf8=Switch}).
parse_decoder_options([], State) ->
State;
parse_decoder_options([{object_hook, Hook} | Rest], State) ->
parse_decoder_options(Rest, State#decoder{object_hook=Hook}).
json_encode(true, _State) ->
<<"true">>;
json_encode(false, _State) ->
<<"false">>;
json_encode(null, _State) ->
<<"null">>;
json_encode(I, _State) when is_integer(I) andalso I >= -2147483648 andalso I =< 2147483647 ->
%% Anything outside of 32-bit integers should be encoded as a float
integer_to_list(I);
json_encode(I, _State) when is_integer(I) ->
mochinum:digits(float(I));
json_encode(F, _State) when is_float(F) ->
mochinum:digits(F);
json_encode(S, State) when is_binary(S); is_atom(S) ->
json_encode_string(S, State);
json_encode(Array, State) when is_list(Array) ->
json_encode_array(Array, State);
json_encode({struct, Props}, State) when is_list(Props) ->
json_encode_proplist(Props, State);
json_encode({json, IoList}, _State) ->
IoList;
json_encode(Bad, #encoder{handler=null}) ->
exit({json_encode, {bad_term, Bad}});
json_encode(Bad, State=#encoder{handler=Handler}) ->
json_encode(Handler(Bad), State).
json_encode_array([], _State) ->
<<"[]">>;
json_encode_array(L, State) ->
F = fun (O, Acc) ->
[$,, json_encode(O, State) | Acc]
end,
[$, | Acc1] = lists:foldl(F, "[", L),
lists:reverse([$\] | Acc1]).
json_encode_proplist([], _State) ->
<<"{}">>;
json_encode_proplist(Props, State) ->
F = fun ({K, V}, Acc) ->
KS = json_encode_string(K, State),
VS = json_encode(V, State),
[$,, VS, $:, KS | Acc]
end,
[$, | Acc1] = lists:foldl(F, "{", Props),
lists:reverse([$\} | Acc1]).
json_encode_string(A, State) when is_atom(A) ->
L = atom_to_list(A),
case json_string_is_safe(L) of
true ->
[?Q, L, ?Q];
false ->
json_encode_string_unicode(xmerl_ucs:from_utf8(L), State, [?Q])
end;
json_encode_string(B, State) when is_binary(B) ->
case json_bin_is_safe(B) of
true ->
[?Q, B, ?Q];
false ->
json_encode_string_unicode(xmerl_ucs:from_utf8(B), State, [?Q])
end;
json_encode_string(I, _State) when is_integer(I) ->
[?Q, integer_to_list(I), ?Q];
json_encode_string(L, State) when is_list(L) ->
case json_string_is_safe(L) of
true ->
[?Q, L, ?Q];
false ->
json_encode_string_unicode(L, State, [?Q])
end.
json_string_is_safe([]) ->
true;
json_string_is_safe([C | Rest]) ->
case C of
?Q ->
false;
$\\ ->
false;
$\b ->
false;
$\f ->
false;
$\n ->
false;
$\r ->
false;
$\t ->
false;
C when C >= 0, C < $\s; C >= 16#7f, C =< 16#10FFFF ->
false;
C when C < 16#7f ->
json_string_is_safe(Rest);
_ ->
false
end.
json_bin_is_safe(<<>>) ->
true;
json_bin_is_safe(<<C, Rest/binary>>) ->
case C of
?Q ->
false;
$\\ ->
false;
$\b ->
false;
$\f ->
false;
$\n ->
false;
$\r ->
false;
$\t ->
false;
C when C >= 0, C < $\s; C >= 16#7f ->
false;
C when C < 16#7f ->
json_bin_is_safe(Rest)
end.
json_encode_string_unicode([], _State, Acc) ->
lists:reverse([$\" | Acc]);
json_encode_string_unicode([C | Cs], State, Acc) ->
Acc1 = case C of
?Q ->
[?Q, $\\ | Acc];
%% Escaping solidus is only useful when trying to protect
%% against "</script>" injection attacks which are only
%% possible when JSON is inserted into a HTML document
%% in-line. mochijson2 does not protect you from this, so
%% if you do insert directly into HTML then you need to
%% uncomment the following case or escape the output of encode.
%%
%% $/ ->
%% [$/, $\\ | Acc];
%%
$\\ ->
[$\\, $\\ | Acc];
$\b ->
[$b, $\\ | Acc];
$\f ->
[$f, $\\ | Acc];
$\n ->
[$n, $\\ | Acc];
$\r ->
[$r, $\\ | Acc];
$\t ->
[$t, $\\ | Acc];
C when C >= 0, C < $\s ->
[unihex(C) | Acc];
C when C >= 16#7f, C =< 16#10FFFF, State#encoder.utf8 ->
[xmerl_ucs:to_utf8(C) | Acc];
C when C >= 16#7f, C =< 16#10FFFF, not State#encoder.utf8 ->
[unihex(C) | Acc];
C when C < 16#7f ->
[C | Acc];
_ ->
exit({json_encode, {bad_char, C}})
end,
json_encode_string_unicode(Cs, State, Acc1).
hexdigit(C) when C >= 0, C =< 9 ->
C + $0;
hexdigit(C) when C =< 15 ->
C + $a - 10.
unihex(C) when C < 16#10000 ->
<<D3:4, D2:4, D1:4, D0:4>> = <<C:16>>,
Digits = [hexdigit(D) || D <- [D3, D2, D1, D0]],
[$\\, $u | Digits];
unihex(C) when C =< 16#10FFFF ->
N = C - 16#10000,
S1 = 16#d800 bor ((N bsr 10) band 16#3ff),
S2 = 16#dc00 bor (N band 16#3ff),
[unihex(S1), unihex(S2)].
json_decode(L, S) when is_list(L) ->
json_decode(iolist_to_binary(L), S);
json_decode(B, S) ->
{Res, S1} = decode1(B, S),
{eof, _} = tokenize(B, S1#decoder{state=trim}),
Res.
decode1(B, S=#decoder{state=null}) ->
case tokenize(B, S#decoder{state=any}) of
{{const, C}, S1} ->
{C, S1};
{start_array, S1} ->
decode_array(B, S1);
{start_object, S1} ->
decode_object(B, S1)
end.
make_object(V, #decoder{object_hook=null}) ->
V;
make_object(V, #decoder{object_hook=Hook}) ->
Hook(V).
decode_object(B, S) ->
decode_object(B, S#decoder{state=key}, []).
decode_object(B, S=#decoder{state=key}, Acc) ->
case tokenize(B, S) of
{end_object, S1} ->
V = make_object({struct, lists:reverse(Acc)}, S1),
{V, S1#decoder{state=null}};
{{const, K}, S1} ->
{colon, S2} = tokenize(B, S1),
{V, S3} = decode1(B, S2#decoder{state=null}),
decode_object(B, S3#decoder{state=comma}, [{K, V} | Acc])
end;
decode_object(B, S=#decoder{state=comma}, Acc) ->
case tokenize(B, S) of
{end_object, S1} ->
V = make_object({struct, lists:reverse(Acc)}, S1),
{V, S1#decoder{state=null}};
{comma, S1} ->
decode_object(B, S1#decoder{state=key}, Acc)
end.
decode_array(B, S) ->
decode_array(B, S#decoder{state=any}, []).
decode_array(B, S=#decoder{state=any}, Acc) ->
case tokenize(B, S) of
{end_array, S1} ->
{lists:reverse(Acc), S1#decoder{state=null}};
{start_array, S1} ->
{Array, S2} = decode_array(B, S1),
decode_array(B, S2#decoder{state=comma}, [Array | Acc]);
{start_object, S1} ->
{Array, S2} = decode_object(B, S1),
decode_array(B, S2#decoder{state=comma}, [Array | Acc]);
{{const, Const}, S1} ->
decode_array(B, S1#decoder{state=comma}, [Const | Acc])
end;
decode_array(B, S=#decoder{state=comma}, Acc) ->
case tokenize(B, S) of
{end_array, S1} ->
{lists:reverse(Acc), S1#decoder{state=null}};
{comma, S1} ->
decode_array(B, S1#decoder{state=any}, Acc)
end.
tokenize_string(B, S=#decoder{offset=O}) ->
case tokenize_string_fast(B, O) of
{escape, O1} ->
Length = O1 - O,
S1 = ?ADV_COL(S, Length),
<<_:O/binary, Head:Length/binary, _/binary>> = B,
tokenize_string(B, S1, lists:reverse(binary_to_list(Head)));
O1 ->
Length = O1 - O,
<<_:O/binary, String:Length/binary, ?Q, _/binary>> = B,
{{const, String}, ?ADV_COL(S, Length + 1)}
end.
tokenize_string_fast(B, O) ->
case B of
<<_:O/binary, ?Q, _/binary>> ->
O;
<<_:O/binary, $\\, _/binary>> ->
{escape, O};
<<_:O/binary, C1, _/binary>> when C1 < 128 ->
tokenize_string_fast(B, 1 + O);
<<_:O/binary, C1, C2, _/binary>> when C1 >= 194, C1 =< 223,
C2 >= 128, C2 =< 191 ->
tokenize_string_fast(B, 2 + O);
<<_:O/binary, C1, C2, C3, _/binary>> when C1 >= 224, C1 =< 239,
C2 >= 128, C2 =< 191,
C3 >= 128, C3 =< 191 ->
tokenize_string_fast(B, 3 + O);
<<_:O/binary, C1, C2, C3, C4, _/binary>> when C1 >= 240, C1 =< 244,
C2 >= 128, C2 =< 191,
C3 >= 128, C3 =< 191,
C4 >= 128, C4 =< 191 ->
tokenize_string_fast(B, 4 + O);
_ ->
throw(invalid_utf8)
end.
tokenize_string(B, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, ?Q, _/binary>> ->
{{const, iolist_to_binary(lists:reverse(Acc))}, ?INC_COL(S)};
<<_:O/binary, "\\\"", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\" | Acc]);
<<_:O/binary, "\\\\", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\\ | Acc]);
<<_:O/binary, "\\/", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$/ | Acc]);
<<_:O/binary, "\\b", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\b | Acc]);
<<_:O/binary, "\\f", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\f | Acc]);
<<_:O/binary, "\\n", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\n | Acc]);
<<_:O/binary, "\\r", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\r | Acc]);
<<_:O/binary, "\\t", _/binary>> ->
tokenize_string(B, ?ADV_COL(S, 2), [$\t | Acc]);
<<_:O/binary, "\\u", C3, C2, C1, C0, Rest/binary>> ->
C = erlang:list_to_integer([C3, C2, C1, C0], 16),
if C > 16#D7FF, C < 16#DC00 ->
%% coalesce UTF-16 surrogate pair
<<"\\u", D3, D2, D1, D0, _/binary>> = Rest,
D = erlang:list_to_integer([D3,D2,D1,D0], 16),
[CodePoint] = xmerl_ucs:from_utf16be(<<C:16/big-unsigned-integer,
D:16/big-unsigned-integer>>),
Acc1 = lists:reverse(xmerl_ucs:to_utf8(CodePoint), Acc),
tokenize_string(B, ?ADV_COL(S, 12), Acc1);
true ->
Acc1 = lists:reverse(xmerl_ucs:to_utf8(C), Acc),
tokenize_string(B, ?ADV_COL(S, 6), Acc1)
end;
<<_:O/binary, C, _/binary>> ->
tokenize_string(B, ?INC_CHAR(S, C), [C | Acc])
end.
tokenize_number(B, S) ->
case tokenize_number(B, sign, S, []) of
{{int, Int}, S1} ->
{{const, list_to_integer(Int)}, S1};
{{float, Float}, S1} ->
{{const, list_to_float(Float)}, S1}
end.
tokenize_number(B, sign, S=#decoder{offset=O}, []) ->
case B of
<<_:O/binary, $-, _/binary>> ->
tokenize_number(B, int, ?INC_COL(S), [$-]);
_ ->
tokenize_number(B, int, S, [])
end;
tokenize_number(B, int, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, $0, _/binary>> ->
tokenize_number(B, frac, ?INC_COL(S), [$0 | Acc]);
<<_:O/binary, C, _/binary>> when C >= $1 andalso C =< $9 ->
tokenize_number(B, int1, ?INC_COL(S), [C | Acc])
end;
tokenize_number(B, int1, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, C, _/binary>> when C >= $0 andalso C =< $9 ->
tokenize_number(B, int1, ?INC_COL(S), [C | Acc]);
_ ->
tokenize_number(B, frac, S, Acc)
end;
tokenize_number(B, frac, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, $., C, _/binary>> when C >= $0, C =< $9 ->
tokenize_number(B, frac1, ?ADV_COL(S, 2), [C, $. | Acc]);
<<_:O/binary, E, _/binary>> when E =:= $e orelse E =:= $E ->
tokenize_number(B, esign, ?INC_COL(S), [$e, $0, $. | Acc]);
_ ->
{{int, lists:reverse(Acc)}, S}
end;
tokenize_number(B, frac1, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, C, _/binary>> when C >= $0 andalso C =< $9 ->
tokenize_number(B, frac1, ?INC_COL(S), [C | Acc]);
<<_:O/binary, E, _/binary>> when E =:= $e orelse E =:= $E ->
tokenize_number(B, esign, ?INC_COL(S), [$e | Acc]);
_ ->
{{float, lists:reverse(Acc)}, S}
end;
tokenize_number(B, esign, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, C, _/binary>> when C =:= $- orelse C=:= $+ ->
tokenize_number(B, eint, ?INC_COL(S), [C | Acc]);
_ ->
tokenize_number(B, eint, S, Acc)
end;
tokenize_number(B, eint, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, C, _/binary>> when C >= $0 andalso C =< $9 ->
tokenize_number(B, eint1, ?INC_COL(S), [C | Acc])
end;
tokenize_number(B, eint1, S=#decoder{offset=O}, Acc) ->
case B of
<<_:O/binary, C, _/binary>> when C >= $0 andalso C =< $9 ->
tokenize_number(B, eint1, ?INC_COL(S), [C | Acc]);
_ ->
{{float, lists:reverse(Acc)}, S}
end.
tokenize(B, S=#decoder{offset=O}) ->
case B of
<<_:O/binary, C, _/binary>> when ?IS_WHITESPACE(C) ->
tokenize(B, ?INC_CHAR(S, C));
<<_:O/binary, "{", _/binary>> ->
{start_object, ?INC_COL(S)};
<<_:O/binary, "}", _/binary>> ->
{end_object, ?INC_COL(S)};
<<_:O/binary, "[", _/binary>> ->
{start_array, ?INC_COL(S)};
<<_:O/binary, "]", _/binary>> ->
{end_array, ?INC_COL(S)};
<<_:O/binary, ",", _/binary>> ->
{comma, ?INC_COL(S)};
<<_:O/binary, ":", _/binary>> ->
{colon, ?INC_COL(S)};
<<_:O/binary, "null", _/binary>> ->
{{const, null}, ?ADV_COL(S, 4)};
<<_:O/binary, "true", _/binary>> ->
{{const, true}, ?ADV_COL(S, 4)};
<<_:O/binary, "false", _/binary>> ->
{{const, false}, ?ADV_COL(S, 5)};
<<_:O/binary, "\"", _/binary>> ->
tokenize_string(B, ?INC_COL(S));
<<_:O/binary, C, _/binary>> when (C >= $0 andalso C =< $9)
orelse C =:= $- ->
tokenize_number(B, S);
<<_:O/binary>> ->
trim = S#decoder.state,
{eof, S}
end.
%%
%% Tests
%%
-include_lib("eunit/include/eunit.hrl").
-ifdef(TEST).
%% testing constructs borrowed from the Yaws JSON implementation.
%% Create an object from a list of Key/Value pairs.
obj_new() ->
{struct, []}.
is_obj({struct, Props}) ->
F = fun ({K, _}) when is_binary(K) -> true end,
lists:all(F, Props).
obj_from_list(Props) ->
Obj = {struct, Props},
?assert(is_obj(Obj)),
Obj.
%% Test for equivalence of Erlang terms.
%% Due to arbitrary order of construction, equivalent objects might
%% compare unequal as erlang terms, so we need to carefully recurse
%% through aggregates (tuples and objects).
equiv({struct, Props1}, {struct, Props2}) ->
equiv_object(Props1, Props2);
equiv(L1, L2) when is_list(L1), is_list(L2) ->
equiv_list(L1, L2);
equiv(N1, N2) when is_number(N1), is_number(N2) -> N1 == N2;
equiv(B1, B2) when is_binary(B1), is_binary(B2) -> B1 == B2;
equiv(A, A) when A =:= true orelse A =:= false orelse A =:= null -> true.
%% Object representation and traversal order is unknown.
%% Use the sledgehammer and sort property lists.
equiv_object(Props1, Props2) ->
L1 = lists:keysort(1, Props1),
L2 = lists:keysort(1, Props2),
Pairs = lists:zip(L1, L2),
true = lists:all(fun({{K1, V1}, {K2, V2}}) ->
equiv(K1, K2) and equiv(V1, V2)
end, Pairs).
%% Recursively compare tuple elements for equivalence.
equiv_list([], []) ->
true;
equiv_list([V1 | L1], [V2 | L2]) ->
equiv(V1, V2) andalso equiv_list(L1, L2).
decode_test() ->
[1199344435545.0, 1] = decode(<<"[1199344435545.0,1]">>),
<<16#F0,16#9D,16#9C,16#95>> = decode([34,"\\ud835","\\udf15",34]).
e2j_vec_test() ->
test_one(e2j_test_vec(utf8), 1).
test_one([], _N) ->
%% io:format("~p tests passed~n", [N-1]),
ok;
test_one([{E, J} | Rest], N) ->
%% io:format("[~p] ~p ~p~n", [N, E, J]),
true = equiv(E, decode(J)),
true = equiv(E, decode(encode(E))),
test_one(Rest, 1+N).
e2j_test_vec(utf8) ->
[
{1, "1"},
{3.1416, "3.14160"}, %% text representation may truncate, trail zeroes
{-1, "-1"},
{-3.1416, "-3.14160"},
{12.0e10, "1.20000e+11"},
{1.234E+10, "1.23400e+10"},
{-1.234E-10, "-1.23400e-10"},
{10.0, "1.0e+01"},
{123.456, "1.23456E+2"},
{10.0, "1e1"},
{<<"foo">>, "\"foo\""},
{<<"foo", 5, "bar">>, "\"foo\\u0005bar\""},
{<<"">>, "\"\""},
{<<"\n\n\n">>, "\"\\n\\n\\n\""},
{<<"\" \b\f\r\n\t\"">>, "\"\\\" \\b\\f\\r\\n\\t\\\"\""},
{obj_new(), "{}"},
{obj_from_list([{<<"foo">>, <<"bar">>}]), "{\"foo\":\"bar\"}"},
{obj_from_list([{<<"foo">>, <<"bar">>}, {<<"baz">>, 123}]),
"{\"foo\":\"bar\",\"baz\":123}"},
{[], "[]"},
{[[]], "[[]]"},
{[1, <<"foo">>], "[1,\"foo\"]"},
%% json array in a json object
{obj_from_list([{<<"foo">>, [123]}]),
"{\"foo\":[123]}"},
%% json object in a json object
{obj_from_list([{<<"foo">>, obj_from_list([{<<"bar">>, true}])}]),
"{\"foo\":{\"bar\":true}}"},
%% fold evaluation order
{obj_from_list([{<<"foo">>, []},
{<<"bar">>, obj_from_list([{<<"baz">>, true}])},
{<<"alice">>, <<"bob">>}]),
"{\"foo\":[],\"bar\":{\"baz\":true},\"alice\":\"bob\"}"},
%% json object in a json array
{[-123, <<"foo">>, obj_from_list([{<<"bar">>, []}]), null],
"[-123,\"foo\",{\"bar\":[]},null]"}
].
%% test utf8 encoding
encoder_utf8_test() ->
%% safe conversion case (default)
[34,"\\u0001","\\u0442","\\u0435","\\u0441","\\u0442",34] =
encode(<<1,"\321\202\320\265\321\201\321\202">>),
%% raw utf8 output (optional)
Enc = mochijson2:encoder([{utf8, true}]),
[34,"\\u0001",[209,130],[208,181],[209,129],[209,130],34] =
Enc(<<1,"\321\202\320\265\321\201\321\202">>).
input_validation_test() ->
Good = [
{16#00A3, <<?Q, 16#C2, 16#A3, ?Q>>}, %% pound
{16#20AC, <<?Q, 16#E2, 16#82, 16#AC, ?Q>>}, %% euro
{16#10196, <<?Q, 16#F0, 16#90, 16#86, 16#96, ?Q>>} %% denarius
],
lists:foreach(fun({CodePoint, UTF8}) ->
Expect = list_to_binary(xmerl_ucs:to_utf8(CodePoint)),
Expect = decode(UTF8)
end, Good),
Bad = [
%% 2nd, 3rd, or 4th byte of a multi-byte sequence w/o leading byte
<<?Q, 16#80, ?Q>>,
%% missing continuations, last byte in each should be 80-BF
<<?Q, 16#C2, 16#7F, ?Q>>,
<<?Q, 16#E0, 16#80,16#7F, ?Q>>,
<<?Q, 16#F0, 16#80, 16#80, 16#7F, ?Q>>,
%% we don't support code points > 10FFFF per RFC 3629
<<?Q, 16#F5, 16#80, 16#80, 16#80, ?Q>>
],
lists:foreach(
fun(X) ->
ok = try decode(X) catch invalid_utf8 -> ok end,
%% could be {ucs,{bad_utf8_character_code}} or
%% {json_encode,{bad_char,_}}
{'EXIT', _} = (catch encode(X))
end, Bad).
inline_json_test() ->
?assertEqual(<<"\"iodata iodata\"">>,
iolist_to_binary(
encode({json, [<<"\"iodata">>, " iodata\""]}))),
?assertEqual({struct, [{<<"key">>, <<"iodata iodata">>}]},
decode(
encode({struct,
[{key, {json, [<<"\"iodata">>, " iodata\""]}}]}))),
ok.
big_unicode_test() ->
UTF8Seq = list_to_binary(xmerl_ucs:to_utf8(16#0001d120)),
?assertEqual(
<<"\"\\ud834\\udd20\"">>,
iolist_to_binary(encode(UTF8Seq))),
?assertEqual(
UTF8Seq,
decode(iolist_to_binary(encode(UTF8Seq)))),
ok.
custom_decoder_test() ->
?assertEqual(
{struct, [{<<"key">>, <<"value">>}]},
(decoder([]))("{\"key\": \"value\"}")),
F = fun ({struct, [{<<"key">>, <<"value">>}]}) -> win end,
?assertEqual(
win,
(decoder([{object_hook, F}]))("{\"key\": \"value\"}")),
ok.
atom_test() ->
%% JSON native atoms
[begin
?assertEqual(A, decode(atom_to_list(A))),
?assertEqual(iolist_to_binary(atom_to_list(A)),
iolist_to_binary(encode(A)))
end || A <- [true, false, null]],
%% Atom to string
?assertEqual(
<<"\"foo\"">>,
iolist_to_binary(encode(foo))),
?assertEqual(
<<"\"\\ud834\\udd20\"">>,
iolist_to_binary(encode(list_to_atom(xmerl_ucs:to_utf8(16#0001d120))))),
ok.
key_encode_test() ->
%% Some forms are accepted as keys that would not be strings in other
%% cases
?assertEqual(
<<"{\"foo\":1}">>,
iolist_to_binary(encode({struct, [{foo, 1}]}))),
?assertEqual(
<<"{\"foo\":1}">>,
iolist_to_binary(encode({struct, [{<<"foo">>, 1}]}))),
?assertEqual(
<<"{\"foo\":1}">>,
iolist_to_binary(encode({struct, [{"foo", 1}]}))),
?assertEqual(
<<"{\"\\ud834\\udd20\":1}">>,
iolist_to_binary(
encode({struct, [{[16#0001d120], 1}]}))),
?assertEqual(
<<"{\"1\":1}">>,
iolist_to_binary(encode({struct, [{1, 1}]}))),
ok.
unsafe_chars_test() ->
Chars = "\"\\\b\f\n\r\t",
[begin
?assertEqual(false, json_string_is_safe([C])),
?assertEqual(false, json_bin_is_safe(<<C>>)),
?assertEqual(<<C>>, decode(encode(<<C>>)))
end || C <- Chars],
?assertEqual(
false,
json_string_is_safe([16#0001d120])),
?assertEqual(
false,
json_bin_is_safe(list_to_binary(xmerl_ucs:to_utf8(16#0001d120)))),
?assertEqual(
[16#0001d120],
xmerl_ucs:from_utf8(
binary_to_list(
decode(encode(list_to_atom(xmerl_ucs:to_utf8(16#0001d120))))))),
?assertEqual(
false,
json_string_is_safe([16#110000])),
?assertEqual(
false,
json_bin_is_safe(list_to_binary(xmerl_ucs:to_utf8([16#110000])))),
%% solidus can be escaped but isn't unsafe by default
?assertEqual(
<<"/">>,
decode(<<"\"\\/\"">>)),
ok.
int_test() ->
?assertEqual(0, decode("0")),
?assertEqual(1, decode("1")),
?assertEqual(11, decode("11")),
ok.
float_fallback_test() ->
?assertEqual(<<"-2147483649.0">>, iolist_to_binary(encode(-2147483649))),
?assertEqual(<<"2147483648.0">>, iolist_to_binary(encode(2147483648))),
ok.
handler_test() ->
?assertEqual(
{'EXIT',{json_encode,{bad_term,{}}}},
catch encode({})),
F = fun ({}) -> [] end,
?assertEqual(
<<"[]">>,
iolist_to_binary((encoder([{handler, F}]))({}))),
ok.
-endif.

156
src/web/mod_http_bindjson.erl Normal file
View File

@ -0,0 +1,156 @@
%%%----------------------------------------------------------------------
%%% File : mod_http_bindjson.erl
%%% Original Author : Stefan Strigler <steve@zeank.in-berlin.de>
%%% Purpose : Implementation of XMPP over BOSH (XEP-0206)
%%% Created : Tue Feb 20 13:15:52 CET 2007
%%%
%%% ejabberd, Copyright (C) 2002-2010 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., 59 Temple Place, Suite 330, Boston, MA
%%% 02111-1307 USA
%%%
%%%----------------------------------------------------------------------
%%%----------------------------------------------------------------------
%%% This module acts as a bridge to ejabberd_http_bind which implements
%%% the real stuff, this is to handle the new pluggable architecture for
%%% extending ejabberd's http service.
%%%----------------------------------------------------------------------
%%% I will probable kill and merge code with the original mod_http_bind
%%% if this feature gains traction.
%%% Eric Cestari
-module(mod_http_bindjson).
-author('steve@zeank.in-berlin.de').
%%-define(ejabberd_debug, true).
-behaviour(gen_mod).
-export([
start/2,
stop/1,
process/2
]).
-include("ejabberd.hrl").
-include("jlib.hrl").
-include("ejabberd_http.hrl").
-include("http_bind.hrl").
%% Duplicated from ejabberd_http_bind.
%% TODO: move to hrl file.
-record(http_bind, {id, pid, to, hold, wait, process_delay, version}).
%%%----------------------------------------------------------------------
%%% API
%%%----------------------------------------------------------------------
process([], #request{method = 'POST',
data = []}) ->
?DEBUG("Bad Request: no data", []),
{400, ?HEADER, {xmlelement, "h1", [],
[{xmlcdata, "400 Bad Request"}]}};
process([], #request{method = 'POST',
data = Data,
ip = IP}) ->
?DEBUG("Incoming data: ~s", [Data]),
%NOTE the whole point of this file is this line.
ejabberd_http_bindjson:process_request(Data, IP);
process([], #request{method = 'GET',
data = []}) ->
{200, ?HEADER, get_human_html_xmlel()};
process([], #request{method = 'OPTIONS',
data = []}) ->
{200, ?OPTIONS_HEADER, []};
process(_Path, _Request) ->
?DEBUG("Bad Request: ~p", [_Request]),
{400, ?HEADER, {xmlelement, "h1", [],
[{xmlcdata, "400 Bad Request"}]}}.
get_human_html_xmlel() ->
Heading = "ejabberd " ++ atom_to_list(?MODULE),
{xmlelement, "html", [{"xmlns", "http://www.w3.org/1999/xhtml"}],
[{xmlelement, "head", [],
[{xmlelement, "title", [], [{xmlcdata, Heading}]}]},
{xmlelement, "body", [],
[{xmlelement, "h1", [], [{xmlcdata, Heading}]},
{xmlelement, "p", [],
[{xmlcdata, "An implementation of "},
{xmlelement, "a",
[{"href", "http://xmpp.org/extensions/xep-0206.html"}],
[{xmlcdata, "XMPP over BOSH (XEP-0206)"}]}]},
{xmlelement, "p", [],
[{xmlcdata, "This web page is only informative. "
"To use HTTP-Bind you need a Jabber/XMPP client that supports it."}
]}
]}]}.
%%%----------------------------------------------------------------------
%%% BEHAVIOUR CALLBACKS
%%%----------------------------------------------------------------------
start(_Host, _Opts) ->
setup_database(),
HTTPBindSupervisor =
{ejabberd_http_bind_sup,
{ejabberd_tmp_sup, start_link,
[ejabberd_http_bind_sup, ejabberd_http_bind]},
permanent,
infinity,
supervisor,
[ejabberd_tmp_sup]},
case supervisor:start_child(ejabberd_sup, HTTPBindSupervisor) of
{ok, _Pid} ->
ok;
{ok, _Pid, _Info} ->
ok;
{error, {already_started, _PidOther}} ->
% mod_http_bind is already started so it will not be started again
ok;
{error, Error} ->
{'EXIT', {start_child_error, Error}}
end.
stop(_Host) ->
case supervisor:terminate_child(ejabberd_sup, ejabberd_http_bind_sup) of
ok ->
ok;
{error, Error} ->
{'EXIT', {terminate_child_error, Error}}
end.
setup_database() ->
migrate_database(),
mnesia:create_table(http_bind,
[{ram_copies, [node()]},
{local_content, true},
{attributes, record_info(fields, http_bind)}]),
mnesia:add_table_copy(http_bind, node(), ram_copies).
migrate_database() ->
case catch mnesia:table_info(http_bind, attributes) of
[id, pid, to, hold, wait, process_delay, version] ->
ok;
_ ->
%% Since the stored information is not important, instead
%% of actually migrating data, let's just destroy the table
mnesia:delete_table(http_bind)
end,
case catch mnesia:table_info(http_bind, local_content) of
false ->
mnesia:delete_table(http_bind);
_ ->
ok
end.

11
src/web/simple_ws_check.erl Normal file
View File

@ -0,0 +1,11 @@
-module (simple_ws_check).
-export ([is_acceptable/6]).
-include("ejabberd.hrl").
is_acceptable(["true"]=Path, Q, Origin, Protocol, IP, Headers)->
?INFO_MSG("Authorized Websocket ~p with: ~n Q = ~p~n Origin = ~p~n Protocol = ~p~n IP = ~p~n Headers = ~p~n",
[Path, Q, Origin, Protocol, IP, Headers]),
true;
is_acceptable(["false"]=Path, Q, Origin, Protocol, IP, Headers)->
?INFO_MSG("Failed Websocket ~p with: ~n Q = ~p~n Origin = ~p~n Protocol = ~p~n IP = ~p~n Headers = ~p~n",
[Path, Q, Origin, Protocol, IP, Headers]),
false.

7
src/web/websocket_test.erl
View File

@ -1,9 +1,10 @@
-module (websocket_test).
-export([start/1, loop/1]).
-export([start_link/1, loop/1]).
% callback on received websockets data
start(Ws) ->
spawn(?MODULE, loop, [Ws]).
start_link(Ws) ->
Pid = spawn_link(?MODULE, loop, [Ws]),
{ok, Pid}.
loop(Ws) ->
receive

362
src/web/xmpp_json.erl Normal file
View File

@ -0,0 +1,362 @@
%%%----------------------------------------------------------------------
%%% File : xmpp_json.erl
%%% Author : Eric Cestari <ecestari@process-one.net>
%%% Purpose : Converts {xmlelement,Name, A, Sub} to/from JSON as per protoxep
%%% Created : 09-20-2010
%%%
%%%
%%% ejabberd, Copyright (C) 2002-2010 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., 59 Temple Place, Suite 330, Boston, MA
%%% 02111-1307 USA
-module (xmpp_json).
-export([to_json/1, from_json/1]).
%%% FROM JSON TO XML
from_json({struct, [{<<"stream">>, _Attr}]=Elems}) ->
parse_start(Elems);
from_json({struct, Elems}) ->
{xmlstreamelement, hd(from_json2({struct, Elems}))}.
from_json2({struct, Elems}) ->
lists:map(fun parse_json/1, Elems).
parse_start([{BinName, {struct, JAttrs}}]) ->
Name = binary_to_list(BinName),
{FullName, Attrs} = lists:foldl(
fun({<<"xml">>, {struct, XML}}, {N, Attrs}) ->
XmlAttrs = parse_json_special_attrs("xml", XML),
{N, lists:merge(Attrs, XmlAttrs)};
({<<"xmlns">>, {struct, XMLNS}}, {N, Attrs}) ->
XmlNsAttrs = parse_json_special_attrs("xmlns", XMLNS),
{N, lists:merge(Attrs, XmlNsAttrs)};
({<<"$$">>, BaseNS}, {N, Attrs})->
{binary_to_list(BaseNS)++":"++N, Attrs};
({Key, Value}, {N, Attrs})->
{N, [{ib2tol(Key), ib2tol(Value)}|Attrs]}
end, {Name, []}, JAttrs),
{xmlstreamstart, FullName, Attrs}.
parse_json({Name, CData}) when is_binary(CData)->
{xmlelement, binary_to_list(Name), [], [{xmlcdata, CData}]};
parse_json({Name, CDatas}) when is_list(CDatas)->
lists:map(fun(CData)->
{xmlelement, binary_to_list(Name), [], [{xmlcdata, CData}]}
end, CDatas);
parse_json({BinName, {struct, JAttrs}}) ->
Name = binary_to_list(BinName),
{FullName, Attrs, SubEls} = lists:foldl(
fun({<<"$">>, Cdata}, {N, Attrs, _SubEls}) when is_binary(Cdata)->
{N, Attrs, [{xmlcdata, Cdata}]};
({<<"$">>, {struct, Elems}}, {N, Attrs, _SubEls}) ->
SE = lists:map(fun parse_json/1, Elems),
{N, Attrs, lists:flatten(SE)}; % due to 4.2.3.3
({<<"xml">>, {struct, XML}}, {N, Attrs, SubEls}) ->
XmlAttrs = parse_json_special_attrs("xml", XML),
{N, lists:merge(Attrs, XmlAttrs), SubEls};
({<<"xmlns">>, {struct, XMLNS}}, {N, Attrs, SubEls}) ->
XmlNsAttrs = parse_json_special_attrs("xmlns", XMLNS),
{N, lists:merge(Attrs, XmlNsAttrs), SubEls};
({Key, {struct, []}}, {N, Attrs, SubEls})->
{N, Attrs, [{xmlelement, ib2tol(Key), [], []}|SubEls]};
({Key, Value}, {N, Attrs, SubEls})->
{N, [{binary_to_list(Key), ib2tol(Value)}|Attrs], SubEls}
end, {Name, [], []}, JAttrs),
{xmlelement, FullName, Attrs, SubEls}.
parse_json_special_attrs(Prefix, XMLNS)->
lists:reverse(lists:map(
fun({<<"$">>, Value})->
{Prefix, ib2tol(Value)};
({<<"@",NS/binary>>, Value})->
{Prefix ++ ":"++binary_to_list(NS), ib2tol(Value)}
end, XMLNS)).
%%% FROM XML TO JSON
to_json({xmlstreamelement, XMLElement})->
to_json(XMLElement);
to_json({xmlelement, _Name, [], []})->
{struct, []};
to_json({xmlelement, Name, [], [{xmlcdata, Cdata}]})->
{SName, JsonAttrs2} = parse_namespace(Name, []),
{struct, [{SName, Cdata}|JsonAttrs2]};
to_json({xmlstreamstart, Name, Attrs})->
JsonAttrs = parse_attrs(Attrs),
{SName, Members2} = parse_namespace(Name, JsonAttrs),
{struct, [{SName, {struct, Members2}}]};
to_json({xmlelement, Name, Attrs, SubEls})->
JsonAttrs = parse_attrs(Attrs),
Members = case parse_subels(SubEls) of
[] ->
JsonAttrs;
[Elem] ->
[{<<"$">>,Elem}|JsonAttrs];
Elems ->
[{<<"$">>,Elems}|JsonAttrs]
end,
{SName, Members2} = parse_namespace(Name, Members),
{struct, [{SName, {struct, Members2}}]}.
parse_namespace(Name, AttrsList)->
{l2b(Name), AttrsList}.
parse_subels([{xmlcdata, Cdata}])->
l2b(Cdata);
parse_subels([])->
[];
parse_subels(SubEls)->
{struct, lists:reverse(lists:foldl(
fun({xmlelement, SName, [], [{xmlcdata, UCdata}]}, Acc)->
Cdata = l2b(UCdata),
Name = l2b(SName),
case lists:keyfind(Name, 1, Acc) of
{Name, PrevCdata} when is_binary(PrevCdata) ->
Acc1 = lists:keydelete(Name, 1, Acc),
[{Name,[PrevCdata, Cdata]} | Acc1];
{Name, CDatas} when is_list(CDatas) ->
Acc1 = lists:keydelete(Name, 1, Acc),
[{Name,lists:append(CDatas, [Cdata])} | Acc1];
_ ->
[{Name, Cdata}| Acc]
end;
({xmlelement, SName, _, _} = Elem, Acc) ->
E = case to_json(Elem) of %TODO There could be a better way to iterate
{struct, [{_, ToKeep}]} -> ToKeep;
{struct, []} = Empty -> Empty
end,
[{l2b(SName), E}|Acc];
({xmlcdata,<<"\n">>}, Acc) ->
Acc
end,[], SubEls))}.
parse_attrs(XmlAttrs)->
{Normal, XMLNS} = lists:foldl(
fun({"xmlns", NS}, {Attrs, XMLNS}) ->
{Attrs,[{<<"$">>, l2b(NS)}| XMLNS]};
({"xmlns:" ++ Short, NS}, {Attrs, XMLNS})->
AttrName = iolist_to_binary([<<"@">>,l2b(Short)]),
{Attrs,[{AttrName, list_to_binary(NS)}| XMLNS]};
({"xml:" ++ Short, Val}, {Attrs, XMLNS})->
% TODO currently tolerates only one xml:* attr per element
AttrName = iolist_to_binary([<<"@">>,l2b(Short)]),
{[{<<"xml">>,{struct, [{AttrName, l2b(Val)}]}}|Attrs], XMLNS};
({K, V}, {Attrs, XMLNS})->
{[{l2b(K), l2b(V)}|Attrs], XMLNS}
end,{[], []}, XmlAttrs),
case XMLNS of
[{<<"$">>, NS}]->
[{<<"xmlns">>, NS}|Normal];
[]->
Normal;
_ ->
[{<<"xmlns">>,{struct, XMLNS} }| Normal]
end.
l2b(List) when is_list(List) -> list_to_binary(List);
l2b(Bin) when is_binary(Bin) -> Bin.
ib2tol(Bin) when is_binary(Bin) -> binary_to_list(Bin );
ib2tol(Integer) when is_integer(Integer) -> integer_to_list(Integer);
ib2tol(List) when is_list(List) -> List.
%%
%% Tests
%% erlc -DTEST web/xmpp_json.erl && erl -pa web/ -run xmpp_json test -run init stop -noshell
-include_lib("eunit/include/eunit.hrl").
-ifdef(TEST).
% 4.2.3.1 Tag with text value
to_text_value_test()->
In = {xmlstreamelement, {xmlelement, "tag", [], [{xmlcdata, <<"txt-value">>}]}},
Out = {struct, [{<<"tag">>, <<"txt-value">>}]},
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.2 Tag with recursive tags
to_tag_with_recursive_tags_test()->
In = {xmlstreamelement, {xmlelement, "tag", [],
[{xmlelement,"tag2",[], [{xmlcdata, <<"txt-value">>}]},
{xmlelement,"tag3",[], [
{xmlelement,"tag4",[], [{xmlcdata, <<"txt2-value">>}]}]}]}},
Out = {struct, [{<<"tag">>,
{struct, [{<<"$">>,
{struct, [
{<<"tag2">>,<<"txt-value">>},
{<<"tag3">>,{struct, [{<<"$">>,{struct, [{<<"tag4">>,<<"txt2-value">>}]}}]}}
]}
}]}
}]
},
%io:format("~n~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
io:format("~n~p", [from_json(Out)]),
io:format("~n~p", [to_json(In)]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.3 Multiple text value tags as array
multiple_text_value_tags_as_array_test()->
In = {xmlstreamelement, {xmlelement, "tag", [], [
{xmlelement,"tag2",[], [
{xmlcdata, <<"txt-value">>}]},
{xmlelement,"tag2",[], [
{xmlcdata, <<"txt-value2">>}]}]}},
Out = {struct, [{<<"tag">>,
{struct, [{<<"$">>,
{struct, [{<<"tag2">>,
[<<"txt-value">>, <<"txt-value2">>]}]}
}]}
}]
},
io:format("~p~n", [to_json(In)]),
io:format("~p~n", [from_json(Out)]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.4 Tag with attribute, no value
tag_attr_no_value_test() ->
In = {xmlstreamelement, {xmlelement, "tag", [{"attr", "attr-value"}], []}},
Out = {struct, [{<<"tag">>, {struct, [
{<<"attr">>,<<"attr-value">>}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
io:format("~p", [from_json(Out)]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.5 Tag with multiple attributes as array, no value
% Not wellformed XML.
% 4.2.3.6 Tags as array with unique attributes, no value
% 4.2.3.7 Tag with namespace attribute, no value
tag_with_namespace_no_value_test()->
In = {xmlstreamelement, {xmlelement, "tag", [{"xmlns:ns", "ns-value"}], []}},
Out = {struct, [{<<"tag">>, {struct, [
{<<"xmlns">>,{struct, [{<<"@ns">>, <<"ns-value">>}]}}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.8 Tag with many attributes to namespace, no value
two_namespaces_tag_no_value_test()->
In = {xmlstreamelement,{xmlelement, "tag", [{"xmlns:ns", "ns-value"},
{"xmlns", "root-value"}], []}},
Out = {struct, [{<<"tag">>, {struct, [
{<<"xmlns">>,{struct, [
{<<"$">>, <<"root-value">>},
{<<"@ns">>, <<"ns-value">>}]}}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.9 Tag with namespace attribute, no value
% Removed namespace handling. More complex on both sides.
namespaced_tag_no_value_test()->
In = {xmlstreamelement,{xmlelement, "ns:tag", [{"attr", "attr-value"}], []}},
Out = {struct, [{<<"ns:tag">>, {struct, [
{<<"attr">>,<<"attr-value">>}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.10 Tag with attribute and text value
tag_with_attribute_and_value_test()->
In = {xmlstreamelement,{xmlelement, "tag", [{"attr", "attr-value"}],
[{xmlcdata, <<"txt-value">>}]}},
Out = {struct, [{<<"tag">>, {struct, [
{<<"$">>, <<"txt-value">>},
{<<"attr">>,<<"attr-value">>}
]}}]},
%io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
% 4.2.3.11 Namespace tag with attribute and text value
% Removed namespace handling. More complex on both sides
namespaced_tag_with_value_test()->
In = {xmlstreamelement,{xmlelement, "ns:tag", [{"attr", "attr-value"}], [{xmlcdata, <<"txt-value">>}]}},
Out = {struct, [{<<"ns:tag">>, {struct, [
{<<"$">>,<<"txt-value">>},
{<<"attr">>,<<"attr-value">>}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
xml_lang_attr_test()->
In = {xmlstreamelement,{xmlelement, "tag", [{"xml:lang", "en"}], []}},
Out = {struct, [{<<"tag">>, {struct, [
{<<"xml">>,{struct,[{<<"@lang">>,<<"en">>}]}}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
xmlns_tag_with_value_test()->
Out = {struct,[{<<"response">>,
{struct,[{<<"$">>,<<"dXNlcm5hbWU9I">>},
{<<"xmlns">>, <<"urn:ietf:params:xml:ns:xmpp-sasl">>}]}}
]},
Out2 = {struct,[{<<"response">>,
{struct,[{<<"xmlns">>, <<"urn:ietf:params:xml:ns:xmpp-sasl">>},
{<<"$">>,<<"dXNlcm5hbWU9I">>}
]}}
]},
In = {xmlstreamelement,{xmlelement,"response",
[{"xmlns","urn:ietf:params:xml:ns:xmpp-sasl"}],
[{xmlcdata, <<"dXNlcm5hbWU9I">>}]}},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)),
?assertEqual(In, from_json(Out2)).
no_attr_no_value_test()->
In = {xmlstreamelement, {xmlelement,"failure",
[{"xmlns","urn:ietf:params:xml:ns:xmpp-sasl"}],
[{xmlelement,"not-authorized",[],[]}]}},
Out = {struct, [{<<"failure">>,{struct, [
{<<"$">>, {struct, [{<<"not-authorized">>, {struct, []}}]}},
{<<"xmlns">>, <<"urn:ietf:params:xml:ns:xmpp-sasl">>}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
io:format("~p~n", [to_json(In)]),
io:format("~p~n", [from_json(Out)]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
xmlstream_test()->
In = {xmlstreamstart, "stream", [{"xml:lang", "en"}]},
Out = {struct, [{<<"stream">>, {struct, [
{<<"xml">>,{struct,[{<<"@lang">>,<<"en">>}]}}
]}}]},
io:format("~p", [list_to_binary(mochijson2:encode(to_json(In)))]),
?assertEqual(Out, to_json(In)),
?assertEqual(In, from_json(Out)).
-endif.