mirror of
https://github.com/processone/ejabberd.git
synced 2024-09-29 14:37:44 +02:00
parent
0fcaef0566
commit
c9ac75474f
56
src/beam_util.erl
Normal file
56
src/beam_util.erl
Normal file
@ -0,0 +1,56 @@
|
|||||||
|
%% Copyright (C) 2009 Romuald du Song <rdusong _AT_ gmail _DOT_ com>.
|
||||||
|
%% All rights reserved.
|
||||||
|
%%
|
||||||
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
|
%% modification, are permitted provided that the following conditions
|
||||||
|
%% are met:
|
||||||
|
%%
|
||||||
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
|
%% copyright notice, this list of conditions and the following
|
||||||
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
|
%% with the distribution.
|
||||||
|
%%
|
||||||
|
%% THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
|
||||||
|
%% OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||||
|
%% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||||
|
%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
||||||
|
%% DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
|
%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
||||||
|
%% GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||||
|
%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||||
|
%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||||
|
%% NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
||||||
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
-module(beam_util).
|
||||||
|
|
||||||
|
-export([module_export_list/1, filter_arity/3]).
|
||||||
|
|
||||||
|
|
||||||
|
%% Module = string()
|
||||||
|
%% Function = atom()
|
||||||
|
module_export_list( Module ) ->
|
||||||
|
{_Module, _Binary, Filename} = code:get_object_code(Module),
|
||||||
|
case beam_lib:info( Filename ) of
|
||||||
|
{error, beam_lib, _} ->
|
||||||
|
false;
|
||||||
|
[ _ , _ , _ ] ->
|
||||||
|
case beam_lib:chunks( Filename, [exports]) of
|
||||||
|
{ok, {_, [{exports, Exports}]}} ->
|
||||||
|
Exports;
|
||||||
|
{error, beam_lib, Er} ->
|
||||||
|
false
|
||||||
|
end
|
||||||
|
end.
|
||||||
|
|
||||||
|
%% Module = string()
|
||||||
|
%% Arity = integer()
|
||||||
|
%% Exports = list()
|
||||||
|
filter_arity( Function, Arity, Exports) ->
|
||||||
|
case lists:filter(
|
||||||
|
fun( EFName ) -> {Function, Arity} == EFName end,
|
||||||
|
Exports ) of
|
||||||
|
[{_, _}] -> true;
|
||||||
|
[] -> false
|
||||||
|
end.
|
11
src/log.hrl
11
src/log.hrl
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -31,13 +31,8 @@
|
|||||||
error_logger:error_report({?MODULE, ?LINE, Reason})).
|
error_logger:error_report({?MODULE, ?LINE, Reason})).
|
||||||
|
|
||||||
-ifdef(DEBUG).
|
-ifdef(DEBUG).
|
||||||
|
|
||||||
-define(DEBUG_LOG(Reason),
|
-define(DEBUG_LOG(Reason),
|
||||||
error_logger:info_report({debug, ?MODULE, ?LINE,
|
error_logger:info_report({debug, ?MODULE, ?LINE, Reason})).
|
||||||
Reason})).
|
|
||||||
|
|
||||||
-else.
|
-else.
|
||||||
|
|
||||||
-define(DEBUG_LOG(Reason), ok).
|
-define(DEBUG_LOG(Reason), ok).
|
||||||
|
|
||||||
-endif.
|
-endif.
|
||||||
|
156
src/tcp_serv.erl
156
src/tcp_serv.erl
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,34 +25,41 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(tcp_serv).
|
-module(tcp_serv).
|
||||||
|
|
||||||
-vsn("1.13").
|
-vsn("1.13").
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
|
||||||
-export([start_link/1, start_link/2, stop/1, stop/2]).
|
-export([start_link/1, start_link/2, stop/1, stop/2]).
|
||||||
|
|
||||||
-export([init/2, start_session/3]).
|
-export([init/2, start_session/3]).
|
||||||
|
|
||||||
-export([system_continue/3, system_terminate/4]).
|
-export([system_continue/3, system_terminate/4]).
|
||||||
|
|
||||||
-include("log.hrl").
|
-include("log.hrl").
|
||||||
|
|
||||||
-record(state,
|
-record(state, {
|
||||||
{max_sessions, session_handler, session_list,
|
%% int()
|
||||||
listen_socket, parent, debug_info}).
|
max_sessions,
|
||||||
|
%% {M, F, A}
|
||||||
|
%% M = F = atom()
|
||||||
|
%% A = [term()]
|
||||||
|
session_handler,
|
||||||
|
%% [pid()]
|
||||||
|
session_list,
|
||||||
|
%% socket()
|
||||||
|
listen_socket,
|
||||||
|
%% pid()
|
||||||
|
parent,
|
||||||
|
%% term()
|
||||||
|
debug_info
|
||||||
|
}).
|
||||||
|
|
||||||
%% Exported: start_link/{1,2}
|
%% Exported: start_link/{1,2}
|
||||||
|
|
||||||
start_link(Args) -> start_link(Args, 60000).
|
start_link(Args) -> start_link(Args, 60000).
|
||||||
|
|
||||||
start_link(Args, Timeout) ->
|
start_link(Args, Timeout) ->
|
||||||
Pid = proc_lib:spawn_link(?MODULE, init,
|
Pid = proc_lib:spawn_link(?MODULE, init, [self(), Args]),
|
||||||
[self(), Args]),
|
|
||||||
receive
|
receive
|
||||||
{Pid, started} -> {ok, Pid};
|
{Pid, started} -> {ok, Pid};
|
||||||
{Pid, Reason} -> {error, Reason}
|
{Pid, Reason} -> {error, Reason}
|
||||||
after Timeout -> {error, timeout}
|
after Timeout -> {error, timeout}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
%% Exported: stop/{1,2}
|
%% Exported: stop/{1,2}
|
||||||
@ -60,83 +67,90 @@ start_link(Args, Timeout) ->
|
|||||||
stop(Pid) -> stop(Pid, 15000).
|
stop(Pid) -> stop(Pid, 15000).
|
||||||
|
|
||||||
stop(Pid, Timeout) ->
|
stop(Pid, Timeout) ->
|
||||||
Pid ! {self(), stop},
|
Pid ! {self(), stop},
|
||||||
receive
|
receive
|
||||||
{Pid, Reply} -> Reply after Timeout -> {error, timeout}
|
{Pid, Reply} -> Reply
|
||||||
|
after
|
||||||
|
Timeout -> {error, timeout}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
%% Exported: init/2
|
%% Exported: init/2
|
||||||
|
|
||||||
init(Parent,
|
init(Parent, [Port, MaxSessions, OptionList, SessionHandler]) ->
|
||||||
[Port, MaxSessions, OptionList, SessionHandler]) ->
|
|
||||||
process_flag(trap_exit, true),
|
process_flag(trap_exit, true),
|
||||||
case gen_tcp:listen(Port, OptionList) of
|
case gen_tcp:listen(Port, OptionList) of
|
||||||
{ok, ListenSocket} ->
|
{ok, ListenSocket} ->
|
||||||
self() ! start_session,
|
self() ! start_session,
|
||||||
Parent ! {self(), started},
|
Parent ! {self(), started},
|
||||||
loop(#state{max_sessions = MaxSessions,
|
loop(#state{max_sessions = MaxSessions,
|
||||||
session_handler = SessionHandler, session_list = [],
|
session_handler = SessionHandler,
|
||||||
listen_socket = ListenSocket, parent = Parent});
|
session_list = [],
|
||||||
Reason -> Parent ! {self(), {not_started, Reason}}
|
listen_socket = ListenSocket,
|
||||||
|
parent = Parent});
|
||||||
|
Reason -> Parent ! {self(), {not_started, Reason}}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
loop(#state{session_list = SessionList,
|
loop(#state{session_list = SessionList, listen_socket = ListenSocket,
|
||||||
listen_socket = ListenSocket, parent = Parent} =
|
parent = Parent} = State) ->
|
||||||
State) ->
|
|
||||||
receive
|
receive
|
||||||
{From, stop} -> cleanup(State), From ! {self(), ok};
|
{From, stop} ->
|
||||||
start_session
|
cleanup(State),
|
||||||
when length(SessionList) > State#state.max_sessions ->
|
From ! {self(), ok};
|
||||||
timer:sleep(5000), self() ! start_session, loop(State);
|
start_session when length(SessionList) > State#state.max_sessions ->
|
||||||
start_session ->
|
timer:sleep(5000),
|
||||||
A = [self(), State#state.session_handler, ListenSocket],
|
self() ! start_session,
|
||||||
Pid = proc_lib:spawn_link(?MODULE, start_session, A),
|
loop(State);
|
||||||
loop(State#state{session_list = [Pid | SessionList]});
|
start_session ->
|
||||||
{'EXIT', Parent, Reason} ->
|
A = [self(), State#state.session_handler, ListenSocket],
|
||||||
cleanup(State), exit(Reason);
|
Pid = proc_lib:spawn_link(?MODULE, start_session, A),
|
||||||
{'EXIT', Pid, Reason} ->
|
loop(State#state{session_list = [Pid|SessionList]});
|
||||||
case lists:member(Pid, SessionList) of
|
{'EXIT', Parent, Reason} ->
|
||||||
true ->
|
cleanup(State),
|
||||||
PurgedSessionList = lists:delete(Pid, SessionList),
|
exit(Reason);
|
||||||
loop(State#state{session_list = PurgedSessionList});
|
{'EXIT', Pid, Reason} ->
|
||||||
false ->
|
case lists:member(Pid, SessionList) of
|
||||||
?ERROR_LOG({ignoring, {'EXIT', Pid, Reason}}),
|
true ->
|
||||||
loop(State)
|
PurgedSessionList = lists:delete(Pid, SessionList),
|
||||||
end;
|
loop(State#state{session_list = PurgedSessionList});
|
||||||
{system, From, Request} ->
|
false ->
|
||||||
sys:handle_system_msg(Request, From, Parent, ?MODULE,
|
?ERROR_LOG({ignoring, {'EXIT', Pid, Reason}}),
|
||||||
State#state.debug_info, State);
|
loop(State)
|
||||||
UnknownMessage ->
|
end;
|
||||||
?ERROR_LOG({unknown_message, UnknownMessage}),
|
{system, From, Request} ->
|
||||||
loop(State)
|
sys:handle_system_msg(Request, From, Parent, ?MODULE,
|
||||||
|
State#state.debug_info, State);
|
||||||
|
UnknownMessage ->
|
||||||
|
?ERROR_LOG({unknown_message, UnknownMessage}),
|
||||||
|
loop(State)
|
||||||
end.
|
end.
|
||||||
|
|
||||||
cleanup(State) ->
|
cleanup(State) -> gen_tcp:close(State#state.listen_socket).
|
||||||
gen_tcp:close(State#state.listen_socket).
|
|
||||||
|
|
||||||
%% Exported: start_seesion/3
|
%% Exported: start_seesion/3
|
||||||
|
|
||||||
start_session(Parent, {M, F, A}, ListenSocket) ->
|
start_session(Parent, {M, F, A}, ListenSocket) ->
|
||||||
case gen_tcp:accept(ListenSocket) of
|
case gen_tcp:accept(ListenSocket) of
|
||||||
{ok, Socket} ->
|
{ok, Socket} ->
|
||||||
Parent ! start_session,
|
Parent ! start_session,
|
||||||
case apply(M, F, [Socket | A]) of
|
case apply(M, F, [Socket|A]) of
|
||||||
ok -> gen_tcp:close(Socket);
|
ok -> gen_tcp:close(Socket);
|
||||||
{error, closed} -> ok;
|
{error, closed} -> ok;
|
||||||
{error, Reason} ->
|
{error, Reason} ->
|
||||||
?ERROR_LOG({M, F, Reason}), gen_tcp:close(Socket)
|
?ERROR_LOG({M, F, Reason}),
|
||||||
end;
|
gen_tcp:close(Socket)
|
||||||
{error, _Reason} ->
|
end;
|
||||||
timer:sleep(5000), Parent ! start_session
|
{error, Reason} ->
|
||||||
|
timer:sleep(5000),
|
||||||
|
Parent ! start_session
|
||||||
end.
|
end.
|
||||||
|
|
||||||
%% Exported: system_continue/3
|
%% Exported: system_continue/3
|
||||||
|
|
||||||
system_continue(Parent, DebugInfo, State) ->
|
system_continue(Parent, DebugInfo, State) ->
|
||||||
loop(State#state{parent = Parent,
|
loop(State#state{parent = Parent, debug_info = DebugInfo}).
|
||||||
debug_info = DebugInfo}).
|
|
||||||
|
|
||||||
%% Exported: system_terminate/3
|
%% Exported: system_terminate/3
|
||||||
|
|
||||||
system_terminate(Reason, _Parent, _DebugInfo, State) ->
|
system_terminate(Reason, Parent, DebugInfo, State) ->
|
||||||
cleanup(State), exit(Reason).
|
cleanup(State),
|
||||||
|
exit(Reason).
|
||||||
|
65
src/url_util.erl
Normal file
65
src/url_util.erl
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
%% Author: Romuald du Song
|
||||||
|
%% Created: 9 oct. 2009
|
||||||
|
%% Description:
|
||||||
|
%% Hacked from Joe Armtrong http://www.erlang.org/examples/small_examples/urlget.erl
|
||||||
|
|
||||||
|
-module(url_util).
|
||||||
|
|
||||||
|
%%
|
||||||
|
%% Include files
|
||||||
|
%%
|
||||||
|
|
||||||
|
%%
|
||||||
|
%% Exported Functions
|
||||||
|
%%
|
||||||
|
-export([parse/1]).
|
||||||
|
|
||||||
|
%%
|
||||||
|
%% API Functions
|
||||||
|
%%
|
||||||
|
|
||||||
|
%%----------------------------------------------------------------------
|
||||||
|
%% parse(URL) -> {http, Site, Port, File} |
|
||||||
|
%% {file, File} | {error,Why}
|
||||||
|
%% (primitive)
|
||||||
|
|
||||||
|
parse([$h,$t,$t,$p,$:,$/,$/|T]) -> parse_http(T, http);
|
||||||
|
parse([$h,$t,$t,$p,$s,$:,$/,$/|T]) -> parse_http(T, https);
|
||||||
|
parse([$f,$t,$p,$:,$/,$/|_T]) -> {error, no_ftp};
|
||||||
|
parse([$f,$i,$l,$e,$:,$/,$/|F]) -> {file, F};
|
||||||
|
parse(_X) -> {error, unknown_url_type}.
|
||||||
|
|
||||||
|
|
||||||
|
%%
|
||||||
|
%% Local Functions
|
||||||
|
%%
|
||||||
|
|
||||||
|
parse_http(X, Protocol) ->
|
||||||
|
case string:chr(X, $/) of
|
||||||
|
0 ->
|
||||||
|
%% not terminated by "/" (sigh)
|
||||||
|
%% try again
|
||||||
|
parse_http(X ++ "/", Protocol);
|
||||||
|
N ->
|
||||||
|
%% The Host is up to the first "/"
|
||||||
|
%% The file is everything else
|
||||||
|
Host = string:substr(X, 1, N-1),
|
||||||
|
File = string:substr(X, N, length(X)),
|
||||||
|
%% Now check to see if the host name contains a colon
|
||||||
|
%% i.e. there is an explicit port address in the hostname
|
||||||
|
case string:chr(Host, $:) of
|
||||||
|
0 ->
|
||||||
|
%% no colon
|
||||||
|
Port = 80,
|
||||||
|
{Protocol, Host, Port, File};
|
||||||
|
M ->
|
||||||
|
Site = string:substr(Host,1,M-1),
|
||||||
|
case (catch list_to_integer(
|
||||||
|
string:substr(Host, M+1, length(Host)))) of
|
||||||
|
{'EXIT', _} ->
|
||||||
|
{Protocol, Site, 80, File};
|
||||||
|
Port ->
|
||||||
|
{Protocol, Site, Port, File}
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end.
|
9
src/xmlrpc.app
Normal file
9
src/xmlrpc.app
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
{application,xmlrpc,
|
||||||
|
[{description,[]},
|
||||||
|
{vsn,"80389e7"},
|
||||||
|
{registered,[]},
|
||||||
|
{applications,[]},
|
||||||
|
{env,[]},
|
||||||
|
{modules,[beam_util,example_serv,tcp_serv,url_util,xmlrpc,
|
||||||
|
xmlrpc_decode,xmlrpc_encode,xmlrpc_http,
|
||||||
|
xmlrpc_util]}]}.
|
8
src/xmlrpc.app.src
Normal file
8
src/xmlrpc.app.src
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
{application, xmlrpc,
|
||||||
|
[
|
||||||
|
{description, ""},
|
||||||
|
{vsn, git},
|
||||||
|
{registered, []},
|
||||||
|
{applications, []},
|
||||||
|
{env, []}
|
||||||
|
]}.
|
359
src/xmlrpc.erl
359
src/xmlrpc.erl
@ -1,12 +1,14 @@
|
|||||||
|
%% Hacked by Romuald du Song
|
||||||
|
%%
|
||||||
%% Copyright (C) 2003 Joakim Grebenö <jocke@gleipnir.com>.
|
%% Copyright (C) 2003 Joakim Grebenö <jocke@gleipnir.com>.
|
||||||
%% All rights reserved.
|
%% All rights reserved.
|
||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,163 +27,244 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(xmlrpc).
|
-module(xmlrpc).
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
-export([call/3, call/4, call/5, call/6, call/7, call/8, call2/7]).
|
||||||
-export([call/3, call/4, call/5, call/6]).
|
-export([start_link/1, start_link/5, start_link/6, stop/1]).
|
||||||
|
|
||||||
-export([start_link/1, start_link/5, start_link/6,
|
|
||||||
stop/1]).
|
|
||||||
|
|
||||||
-include("log.hrl").
|
-include("log.hrl").
|
||||||
|
|
||||||
-record(header, {content_length :: non_neg_integer(),
|
-include("xmlrpc.hrl").
|
||||||
connection :: close}).
|
|
||||||
|
|
||||||
%% Exported: call/{3,4,5,6}
|
%% Exported: call/{3,4,5,6,7,8}
|
||||||
|
|
||||||
call(Host, Port, URI, Payload) ->
|
|
||||||
call(Host, Port, URI, Payload, false, 60000).
|
|
||||||
|
|
||||||
call(Host, Port, URI, Payload, KeepAlive, Timeout) ->
|
|
||||||
case gen_tcp:connect(Host, Port, [binary, {active, false}]) of
|
|
||||||
{ok, Socket} ->
|
|
||||||
call(Socket, URI, Payload, KeepAlive, Timeout);
|
|
||||||
{error, Reason} when KeepAlive == false ->
|
|
||||||
{error, Reason};
|
|
||||||
{error, Reason} -> {error, undefined, Reason}
|
|
||||||
end.
|
|
||||||
|
|
||||||
call(Socket, URI, Payload) ->
|
call(Socket, URI, Payload) ->
|
||||||
call(Socket, URI, Payload, false, 60000).
|
call2(Socket, URI, Payload, false, 60000, "", [{ssl, false}, {header, false}]).
|
||||||
|
|
||||||
|
call(Host, Port, URI, Payload, Options) when is_number(Port) ->
|
||||||
|
call(Host, Port, URI, Payload, false, 60000, "", Options);
|
||||||
|
|
||||||
call(Socket, URI, Payload, KeepAlive, Timeout) ->
|
call(Socket, URI, Payload, KeepAlive, Timeout) ->
|
||||||
?DEBUG_LOG({decoded_call, Payload}),
|
call2(Socket, URI, Payload, KeepAlive, Timeout, "", [{ssl, false}, {header, false}]).
|
||||||
EncodedPayload = xmlrpc_encode:payload(Payload),
|
|
||||||
?DEBUG_LOG({encoded_call, EncodedPayload}),
|
call(Host, Port, URI, Payload) when is_number(Port) ->
|
||||||
case send(Socket, URI, KeepAlive, EncodedPayload) of
|
call(Host, Port, URI, Payload, false, 60000, "", [{ssl, false}, {header, false}]);
|
||||||
ok ->
|
|
||||||
case parse_response(Socket, Timeout) of
|
call(Socket, URI, Payload, Options) ->
|
||||||
{ok, Header} ->
|
call2(Socket, URI, Payload, false, 60000, "", Options).
|
||||||
handle_payload(Socket, KeepAlive, Timeout, Header);
|
|
||||||
{error, Reason} when KeepAlive == false ->
|
call(Host, Port, URI, Payload, KeepAlive, Timeout) when is_number(Port) ->
|
||||||
gen_tcp:close(Socket), {error, Reason};
|
call(Host, Port, URI, Payload, KeepAlive, Timeout, "", [{ssl, false}, {header, false}]);
|
||||||
{error, Reason} -> {error, Socket, Reason}
|
|
||||||
end;
|
call(Socket, URI, Payload, KeepAlive, Timeout, Options) ->
|
||||||
{error, Reason} when KeepAlive == false ->
|
call2(Socket, URI, Payload, KeepAlive, Timeout, "", Options).
|
||||||
gen_tcp:close(Socket), {error, Reason};
|
|
||||||
{error, Reason} -> {error, Socket, Reason}
|
call(Host, Port, URI, Payload, KeepAlive, Timeout, Options) when is_number(Port) ->
|
||||||
|
call(Host, Port, URI, Payload, KeepAlive, Timeout, "", Options);
|
||||||
|
|
||||||
|
call(Socket, URI, Payload, KeepAlive, Timeout, ExtraHeader, Options) ->
|
||||||
|
call2(Socket, URI, Payload, KeepAlive, Timeout, ExtraHeader, Options).
|
||||||
|
|
||||||
|
call(Host, Port, URI, Payload, KeepAlive, Timeout, ExtraHeaders, Options) when is_number(Port) ->
|
||||||
|
case open_socket(Host, Port, Options) of
|
||||||
|
{ok, Socket} -> call2(Socket, URI, Payload, KeepAlive, Timeout, ExtraHeaders, Options);
|
||||||
|
{error, Reason} when KeepAlive == false -> {error, Reason};
|
||||||
|
{error, Reason} -> {error, undefined, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
send(Socket, URI, false, Payload) ->
|
|
||||||
send(Socket, URI, <<"Connection: close\r\n">>, Payload);
|
|
||||||
send(Socket, URI, true, Payload) ->
|
|
||||||
send(Socket, URI, <<"">>, Payload);
|
|
||||||
send(Socket, URI, Header, Payload) ->
|
|
||||||
Request = [<<"POST ">>, URI, <<" HTTP/1.1\r\n">>,
|
|
||||||
<<"Content-Length: ">>,
|
|
||||||
jlib:integer_to_binary(byte_size(Payload)),
|
|
||||||
<<"\r\n">>,
|
|
||||||
<<"User-Agent: Erlang XML-RPC Client 1.13\r\n">>,
|
|
||||||
<<"Content-Type: text/xml\r\n">>, Header, <<"\r\n">>,
|
|
||||||
Payload],
|
|
||||||
gen_tcp:send(Socket, Request).
|
|
||||||
|
|
||||||
parse_response(Socket, Timeout) ->
|
open_socket(Host, Port, Options) ->
|
||||||
inet:setopts(Socket, [binary, {packet, line}]),
|
case fetch_comm_module(Options) of
|
||||||
case gen_tcp:recv(Socket, 0, Timeout) of
|
ssl ->
|
||||||
{ok, <<"HTTP/1.1 200 OK\r\n">>} ->
|
%% Start ssl application
|
||||||
parse_header(Socket, Timeout);
|
application:start(ssl),
|
||||||
{ok, StatusLine} -> {error, StatusLine};
|
%% Always seed
|
||||||
{error, Reason} -> {error, Reason}
|
ssl:seed("wheredoyouthinkitcanbefound"),
|
||||||
|
%% new ssl implementation does not seem to work as of R13B01
|
||||||
|
%%{ok, SslSocket} = ssl:connect(Host, Port, [{ssl_imp, new}, {active, false}, {verify, verify_none}]),
|
||||||
|
ssl:connect(Host, Port, [{verify, 0}, {active, false}]);
|
||||||
|
_ ->
|
||||||
|
gen_tcp:connect(Host, Port, [{active, false}])
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
call2(Socket, URI, Payload, KeepAlive, Timeout, ExtraHeader, Options) ->
|
||||||
|
?DEBUG_LOG({decoded_call, Payload}),
|
||||||
|
case xmlrpc_encode:payload(Payload) of
|
||||||
|
{ok, EncodedPayload} ->
|
||||||
|
?DEBUG_LOG({encoded_call, EncodedPayload}),
|
||||||
|
case send(Socket, URI, KeepAlive, EncodedPayload, ExtraHeader, Options) of
|
||||||
|
ok ->
|
||||||
|
case parse_response(Socket, Timeout, Options) of
|
||||||
|
{ok, Header} ->
|
||||||
|
handle_payload(Socket, KeepAlive, Timeout, Options, Header);
|
||||||
|
{error, Reason} when KeepAlive == false ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Reason};
|
||||||
|
{error, Reason} -> {error, Socket, Reason}
|
||||||
|
end;
|
||||||
|
{error, Reason} when KeepAlive == false ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Reason};
|
||||||
|
{error, Reason} -> {error, Socket, Reason}
|
||||||
|
end;
|
||||||
|
{error, Reason} when KeepAlive == false ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Reason};
|
||||||
|
{error, Reason} -> {error, Socket, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
send(Socket, URI, false, Payload, ExtraHeader, SslOption) ->
|
||||||
|
send(Socket, URI, lists:flatten(["Connection: close\r\n" | ExtraHeader]), Payload, SslOption);
|
||||||
|
send(Socket, URI, true, Payload, ExtraHeader, SslOption) ->
|
||||||
|
send(Socket, URI, ExtraHeader, Payload, SslOption).
|
||||||
|
|
||||||
|
send(Socket, URI, Header, Payload, SslOption) ->
|
||||||
|
Request =
|
||||||
|
["POST ", URI, " HTTP/1.1\r\n",
|
||||||
|
"Content-Length: ", integer_to_list(lists:flatlength(Payload)),
|
||||||
|
"\r\n",
|
||||||
|
"User-Agent: Erlang XML-RPC Client 1.13\r\n",
|
||||||
|
"Content-Type: text/xml\r\n",
|
||||||
|
Header, "\r\n",
|
||||||
|
Payload],
|
||||||
|
M = fetch_comm_module(SslOption),
|
||||||
|
apply(M, send, [Socket, Request]).
|
||||||
|
|
||||||
|
parse_response(Socket, Timeout, SslOption) ->
|
||||||
|
M = fetch_comm_module(SslOption),
|
||||||
|
S = fetch_sets_module(SslOption),
|
||||||
|
apply(S, setopts, [Socket, [{packet, line}]]),
|
||||||
|
case apply(M, recv, [Socket, 0, Timeout]) of
|
||||||
|
{ok, "HTTP/1.1 200 OK\r\n"} -> parse_header(Socket, Timeout, SslOption);
|
||||||
|
{ok, StatusLine} -> {error, StatusLine};
|
||||||
|
{error, Reason} -> {error, Reason}
|
||||||
|
end.
|
||||||
|
|
||||||
|
fetch_comm_module(Options) ->
|
||||||
|
case lists:keysearch(ssl, 1, Options) of
|
||||||
|
{value, {ssl, true}} -> ssl;
|
||||||
|
_ -> gen_tcp
|
||||||
|
end.
|
||||||
|
|
||||||
|
has_header_option(Options) ->
|
||||||
|
case lists:keysearch(header, 1, Options) of
|
||||||
|
{value, {_, true}} -> true;
|
||||||
|
_ -> false
|
||||||
|
end.
|
||||||
|
|
||||||
|
fetch_sets_module(Options) ->
|
||||||
|
case lists:keysearch(ssl, 1, Options) of
|
||||||
|
{value, {ssl, true}} -> ssl;
|
||||||
|
_ -> inet
|
||||||
|
end.
|
||||||
|
|
||||||
|
comm_close(Options, Socket) ->
|
||||||
|
M = fetch_comm_module(Options),
|
||||||
|
apply(M, close, [ Socket ]).
|
||||||
|
|
||||||
|
parse_header(Socket, Timeout, SslOption) -> parse_header(Socket, Timeout, SslOption, #header{}).
|
||||||
|
|
||||||
|
parse_header(Socket, Timeout, SslOption, Header) ->
|
||||||
|
M = fetch_comm_module(SslOption),
|
||||||
|
case apply(M, recv, [Socket, 0, Timeout]) of
|
||||||
|
{ok, "\r\n"} when Header#header.content_length == undefined ->
|
||||||
|
{error, missing_content_length};
|
||||||
|
{ok, "\r\n"} -> {ok, Header};
|
||||||
|
{ok, HeaderField} ->
|
||||||
|
case string:tokens(HeaderField, " \r\n") of
|
||||||
|
["Content-Length:", ContentLength] ->
|
||||||
|
case catch list_to_integer(ContentLength) of
|
||||||
|
badarg ->
|
||||||
|
{error, {invalid_content_length, ContentLength}};
|
||||||
|
Value ->
|
||||||
|
parse_header(Socket, Timeout, SslOption,
|
||||||
|
Header#header{content_length =
|
||||||
|
Value})
|
||||||
|
end;
|
||||||
|
["Connection:", "close"] ->
|
||||||
|
parse_header(Socket, Timeout, SslOption,
|
||||||
|
Header#header{connection = close});
|
||||||
|
["Authorization:", Authorization] ->
|
||||||
|
parse_header(Socket, Timeout, SslOption,
|
||||||
|
Header#header{authorization = Authorization});
|
||||||
|
["Cookie:", Cookie] ->
|
||||||
|
Cookies = [ Cookie | Header#header.cookies ],
|
||||||
|
parse_header(Socket, Timeout, SslOption,
|
||||||
|
Header#header{cookies = Cookies});
|
||||||
|
_ ->
|
||||||
|
parse_header(Socket, Timeout, SslOption, Header)
|
||||||
|
end;
|
||||||
|
{error, Reason} -> {error, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
parse_header(Socket, Timeout) ->
|
handle_payload(Socket, KeepAlive, Timeout, Options, Header) ->
|
||||||
parse_header(Socket, Timeout, #header{}).
|
case get_payload(Socket, Timeout, Options, Header#header.content_length) of
|
||||||
|
{ok, Payload} ->
|
||||||
parse_header(Socket, Timeout, Header) ->
|
?DEBUG_LOG({encoded_response, Payload}),
|
||||||
case gen_tcp:recv(Socket, 0, Timeout) of
|
case xmlrpc_decode:payload(Payload) of
|
||||||
{ok, <<"\r\n">>}
|
{ok, {response, DecodedPayload}} when KeepAlive == false ->
|
||||||
when Header#header.content_length == undefined ->
|
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
||||||
{error, missing_content_length};
|
comm_close(Options, Socket),
|
||||||
{ok, <<"\r\n">>} -> {ok, Header};
|
case has_header_option(Options) of
|
||||||
{ok, HeaderField} ->
|
true ->
|
||||||
case str:tokens(HeaderField, <<" \r\n">>) of
|
{ok, {response, DecodedPayload, Header}};
|
||||||
[<<"Content-Length:">>, ContentLength] ->
|
_ ->
|
||||||
case catch jlib:binary_to_integer(ContentLength) of
|
{ok, {response, DecodedPayload}}
|
||||||
Value when is_integer(Value), Value>=0 ->
|
end;
|
||||||
parse_header(Socket, Timeout,
|
{ok, {response, DecodedPayload}} when KeepAlive == true,
|
||||||
Header#header{content_length = Value});
|
Header#header.connection == close ->
|
||||||
_ ->
|
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
||||||
{error, {invalid_content_length, ContentLength}}
|
comm_close(Options, Socket),
|
||||||
end;
|
case has_header_option(Options) of
|
||||||
[<<"Connection:">>, <<"close">>] ->
|
true ->
|
||||||
parse_header(Socket, Timeout,
|
{ok, Socket, {response, DecodedPayload, Header}};
|
||||||
Header#header{connection = close});
|
_ ->
|
||||||
_ -> parse_header(Socket, Timeout, Header)
|
{ok, Socket, {response, DecodedPayload}}
|
||||||
end;
|
end;
|
||||||
{error, Reason} -> {error, Reason}
|
{ok, {response, DecodedPayload}} ->
|
||||||
|
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
||||||
|
case has_header_option(Options) of
|
||||||
|
true ->
|
||||||
|
{ok, Socket, {response, DecodedPayload, Header}};
|
||||||
|
_ ->
|
||||||
|
{ok, Socket, {response, DecodedPayload}}
|
||||||
|
end;
|
||||||
|
{error, Reason} when KeepAlive == false ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Reason};
|
||||||
|
{error, Reason} when KeepAlive == true,
|
||||||
|
Header#header.connection == close ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Socket, Reason};
|
||||||
|
{error, Reason} ->
|
||||||
|
{error, Socket, Reason}
|
||||||
|
end;
|
||||||
|
{error, Reason} when KeepAlive == false ->
|
||||||
|
gen_tcp:close(Socket),
|
||||||
|
{error, Reason};
|
||||||
|
{error, Reason} when KeepAlive == true,
|
||||||
|
Header#header.connection == close ->
|
||||||
|
comm_close(Options, Socket),
|
||||||
|
{error, Socket, Reason};
|
||||||
|
{error, Reason} -> {error, Socket, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
handle_payload(Socket, KeepAlive, Timeout, Header) ->
|
get_payload(Socket, Timeout, SslOption, ContentLength) ->
|
||||||
case get_payload(Socket, Timeout,
|
M = fetch_comm_module(SslOption),
|
||||||
Header#header.content_length)
|
apply(fetch_sets_module(SslOption), setopts, [Socket, [{packet, raw}]]),
|
||||||
of
|
apply(M, recv, [Socket, ContentLength, Timeout]).
|
||||||
{ok, Payload} ->
|
|
||||||
?DEBUG_LOG({encoded_response, Payload}),
|
|
||||||
case xmlrpc_decode:payload(Payload) of
|
|
||||||
{ok, DecodedPayload} when KeepAlive == false ->
|
|
||||||
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
|
||||||
gen_tcp:close(Socket),
|
|
||||||
{ok, DecodedPayload};
|
|
||||||
{ok, DecodedPayload}
|
|
||||||
when KeepAlive == true,
|
|
||||||
Header#header.connection == close ->
|
|
||||||
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
|
||||||
gen_tcp:close(Socket),
|
|
||||||
{ok, Socket, DecodedPayload};
|
|
||||||
{ok, DecodedPayload} ->
|
|
||||||
?DEBUG_LOG({decoded_response, DecodedPayload}),
|
|
||||||
{ok, Socket, DecodedPayload};
|
|
||||||
{error, Reason} when KeepAlive == false ->
|
|
||||||
gen_tcp:close(Socket), {error, Reason};
|
|
||||||
{error, Reason}
|
|
||||||
when KeepAlive == true,
|
|
||||||
Header#header.connection == close ->
|
|
||||||
gen_tcp:close(Socket), {error, Socket, Reason};
|
|
||||||
{error, Reason} -> {error, Socket, Reason}
|
|
||||||
end;
|
|
||||||
{error, Reason} when KeepAlive == false ->
|
|
||||||
gen_tcp:close(Socket), {error, Reason};
|
|
||||||
{error, Reason}
|
|
||||||
when KeepAlive == true,
|
|
||||||
Header#header.connection == close ->
|
|
||||||
gen_tcp:close(Socket), {error, Socket, Reason};
|
|
||||||
{error, Reason} -> {error, Socket, Reason}
|
|
||||||
end.
|
|
||||||
|
|
||||||
get_payload(Socket, Timeout, ContentLength) ->
|
|
||||||
inet:setopts(Socket, [binary, {packet, raw}]),
|
|
||||||
gen_tcp:recv(Socket, ContentLength, Timeout).
|
|
||||||
|
|
||||||
%% Exported: start_link/{1,5,6}
|
%% Exported: start_link/{1,5,6}
|
||||||
|
|
||||||
start_link(Handler) ->
|
start_link(Handler) -> start_link(4567, 1000, 60000, Handler, undefined).
|
||||||
start_link(4567, 1000, 60000, Handler, undefined).
|
|
||||||
|
|
||||||
start_link(Port, MaxSessions, Timeout, Handler,
|
start_link(Port, MaxSessions, Timeout, Handler, State) ->
|
||||||
State) ->
|
start_link(all, Port, MaxSessions, Timeout, Handler, State).
|
||||||
start_link(all, Port, MaxSessions, Timeout, Handler,
|
|
||||||
State).
|
|
||||||
|
|
||||||
start_link(IP, Port, MaxSessions, Timeout, Handler,
|
start_link(IP, Port, MaxSessions, Timeout, Handler, State) ->
|
||||||
State) ->
|
OptionList = [{active, false}, {reuseaddr, true}] ++ ip(IP),
|
||||||
OptionList = [{active, false}, {reuseaddr, true}] ++
|
SessionHandler = {xmlrpc_http, handler, [Timeout, Handler, State]},
|
||||||
ip(IP),
|
tcp_serv:start_link([Port, MaxSessions, OptionList, SessionHandler]).
|
||||||
SessionHandler = {xmlrpc_http, handler,
|
|
||||||
[Timeout, Handler, State]},
|
|
||||||
tcp_serv:start_link([Port, MaxSessions, OptionList,
|
|
||||||
SessionHandler]).
|
|
||||||
|
|
||||||
ip(all) -> [];
|
ip(all) -> [];
|
||||||
ip(IP) when is_tuple(IP) -> [{ip, IP}].
|
ip(IP) when is_tuple(IP) -> [{ip, IP}].
|
||||||
|
41
src/xmlrpc.hrl
Normal file
41
src/xmlrpc.hrl
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
%% Copyright (C) 2003 Joakim Grebenö <jocke@gleipnir.com>.
|
||||||
|
%% All rights reserved.
|
||||||
|
%%
|
||||||
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
|
%% modification, are permitted provided that the following conditions
|
||||||
|
%% are met:
|
||||||
|
%%
|
||||||
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
|
%% copyright notice, this list of conditions and the following
|
||||||
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
|
%% with the distribution.
|
||||||
|
%%
|
||||||
|
%% THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
|
||||||
|
%% OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||||
|
%% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||||
|
%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
||||||
|
%% DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
|
%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
||||||
|
%% GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||||
|
%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||||
|
%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
||||||
|
%% NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
||||||
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
|
-record(header, {
|
||||||
|
%% int()
|
||||||
|
content_length,
|
||||||
|
%% string()
|
||||||
|
content_type,
|
||||||
|
%% string()
|
||||||
|
user_agent,
|
||||||
|
%% close | undefined
|
||||||
|
connection,
|
||||||
|
%% string()
|
||||||
|
authorization,
|
||||||
|
%% list()
|
||||||
|
cookies
|
||||||
|
}).
|
||||||
|
|
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,217 +25,200 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(xmlrpc_decode).
|
-module(xmlrpc_decode).
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
|
||||||
-export([payload/1]).
|
-export([payload/1]).
|
||||||
|
|
||||||
-include("log.hrl").
|
|
||||||
|
|
||||||
-include_lib("xmerl/include/xmerl.hrl").
|
-include_lib("xmerl/include/xmerl.hrl").
|
||||||
|
|
||||||
payload(Payload) ->
|
payload(Payload) ->
|
||||||
?DEBUG_LOG({scanning_payload, Payload}),
|
case catch xmerl_scan:string(Payload, [{encoding, latin1}]) of
|
||||||
case xmerl_scan:string(Payload) of
|
{'EXIT', Reason} -> {error, Reason};
|
||||||
{error, Reason} ->
|
{E, _} ->
|
||||||
?DEBUG_LOG({error_scanning, Payload, Reason}),
|
case catch decode_element(E) of
|
||||||
{error, Reason};
|
{'EXIT', Reason} -> {error, Reason};
|
||||||
{E, _} ->
|
Result -> Result
|
||||||
?DEBUG_LOG({decoding_element, E}),
|
end
|
||||||
case catch decode_element(E) of
|
|
||||||
{'EXIT', Reason} ->
|
|
||||||
?DEBUG_LOG({error_deconding, E, Reason}), exit(Reason);
|
|
||||||
Result ->
|
|
||||||
?DEBUG_LOG({result_deconding, E, Result}), Result
|
|
||||||
end
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
decode_element(#xmlElement{name = methodCall} =
|
decode_element(#xmlElement{name = methodCall} = MethodCall)
|
||||||
MethodCall)
|
when record(MethodCall, xmlElement) ->
|
||||||
when is_record(MethodCall, xmlElement) ->
|
{MethodName, Rest} =
|
||||||
{MethodName, Rest} = match_element([methodName],
|
match_element([methodName], MethodCall#xmlElement.content),
|
||||||
MethodCall#xmlElement.content),
|
TextValue = get_text_value(MethodName#xmlElement.content),
|
||||||
TextValue =
|
|
||||||
get_text_value(MethodName#xmlElement.content),
|
|
||||||
case match_element(normal, [params], Rest) of
|
case match_element(normal, [params], Rest) of
|
||||||
{error, {missing_element, _}} ->
|
{error, {missing_element, _}} ->
|
||||||
{ok, {call, jlib:binary_to_atom(TextValue), []}};
|
{ok, {call, list_to_atom(TextValue), []}};
|
||||||
{Params, _} ->
|
{Params, _} ->
|
||||||
DecodedParams =
|
DecodedParams = decode_params(Params#xmlElement.content),
|
||||||
decode_params(Params#xmlElement.content),
|
{ok, {call, list_to_atom(TextValue), DecodedParams}}
|
||||||
{ok,
|
|
||||||
{call, jlib:binary_to_atom(TextValue), DecodedParams}}
|
|
||||||
end;
|
end;
|
||||||
decode_element(#xmlElement{name = methodResponse} =
|
decode_element(#xmlElement{name = methodResponse} = MethodResponse)
|
||||||
MethodResponse)
|
when record(MethodResponse, xmlElement) ->
|
||||||
when is_record(MethodResponse, xmlElement) ->
|
case match_element([fault, params], MethodResponse#xmlElement.content) of
|
||||||
case match_element([fault, params],
|
{Fault, _} when Fault#xmlElement.name == fault ->
|
||||||
MethodResponse#xmlElement.content)
|
{Value, _} = match_element([value], Fault#xmlElement.content),
|
||||||
of
|
case decode(Value#xmlElement.content) of
|
||||||
{Fault, _} when Fault#xmlElement.name == fault ->
|
{struct, [{faultCode, Code},
|
||||||
{Value, _} = match_element([value],
|
{faultString, String}]} when integer(Code) ->
|
||||||
Fault#xmlElement.content),
|
case xmlrpc_util:is_string(String) of
|
||||||
case decode(Value#xmlElement.content) of
|
yes -> {ok, {response, {fault, Code, String}}};
|
||||||
{struct, [{faultCode, Code}, {faultString, String}]}
|
no -> {error, {bad_string, String}}
|
||||||
when is_integer(Code) ->
|
end;
|
||||||
case xmlrpc_util:is_string(String) of
|
{struct, [{faultString, String},
|
||||||
yes -> {ok, {response, {fault, Code, String}}};
|
{faultCode, Code}]} when integer(Code) ->
|
||||||
no -> {error, {bad_string, String}}
|
%% This case has been found in java xmlrpc
|
||||||
end;
|
case xmlrpc_util:is_string(String) of
|
||||||
_ -> {error, {bad_element, MethodResponse}}
|
yes -> {ok, {response, {fault, Code, String}}};
|
||||||
end;
|
no -> {error, {bad_string, String}}
|
||||||
{Params, _} ->
|
end;
|
||||||
case decode_params(Params#xmlElement.content) of
|
_ ->
|
||||||
[DecodedParam] -> {ok, {response, [DecodedParam]}};
|
{error, {bad_element, MethodResponse}}
|
||||||
DecodedParams ->
|
end;
|
||||||
{error, {to_many_params, DecodedParams}}
|
{Params, _} ->
|
||||||
end
|
case decode_params(Params#xmlElement.content) of
|
||||||
|
[DecodedParam] -> {ok, {response, [DecodedParam]}};
|
||||||
|
DecodedParams -> {error, {to_many_params, DecodedParams}}
|
||||||
|
end
|
||||||
end;
|
end;
|
||||||
decode_element(E) -> {error, {bad_element, E}}.
|
decode_element(E) -> {error, {bad_element, E}}.
|
||||||
|
|
||||||
match_element(NameList, Content) ->
|
match_element(NameList, Content) -> match_element(throw, NameList, Content).
|
||||||
match_element(throw, NameList, Content).
|
|
||||||
|
|
||||||
match_element(Type, NameList, []) ->
|
match_element(Type, NameList, []) ->
|
||||||
return(Type, {error, {missing_element, NameList}});
|
return(Type, {error, {missing_element, NameList}});
|
||||||
match_element(Type, NameList, [E | Rest])
|
match_element(Type, NameList, [E|Rest]) when record(E, xmlElement) ->
|
||||||
when is_record(E, xmlElement) ->
|
|
||||||
case lists:member(E#xmlElement.name, NameList) of
|
case lists:member(E#xmlElement.name, NameList) of
|
||||||
true -> {E, Rest};
|
true -> {E, Rest};
|
||||||
false ->
|
false -> return(Type, {error, {unexpected_element, E#xmlElement.name}})
|
||||||
return(Type,
|
|
||||||
{error, {unexpected_element, E#xmlElement.name}})
|
|
||||||
end;
|
end;
|
||||||
match_element(Type, NameList, [T | Rest])
|
match_element(Type, NameList, [T|Rest]) when record(T, xmlText) ->
|
||||||
when is_record(T, xmlText) ->
|
|
||||||
case only_whitespace(T#xmlText.value) of
|
case only_whitespace(T#xmlText.value) of
|
||||||
yes -> match_element(Type, NameList, Rest);
|
yes -> match_element(Type, NameList, Rest);
|
||||||
no ->
|
no ->
|
||||||
return(Type,
|
return(Type, {error, {unexpected_text, T#xmlText.value, NameList}})
|
||||||
{error, {unexpected_text, T#xmlText.value, NameList}})
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
return(throw, Result) -> throw(Result);
|
return(throw, Result) -> throw(Result);
|
||||||
return(normal, Result) -> Result.
|
return(normal, Result) -> Result.
|
||||||
|
|
||||||
only_whitespace(<<>>) -> yes;
|
only_whitespace([]) -> yes;
|
||||||
only_whitespace(<<$\s, Rest/binary>>) ->
|
only_whitespace([$ |Rest]) -> only_whitespace(Rest);
|
||||||
only_whitespace(Rest);
|
only_whitespace([$\n|Rest]) -> only_whitespace(Rest);
|
||||||
only_whitespace(<<$\n, Rest/binary>>) ->
|
only_whitespace([$\t|Rest]) -> only_whitespace(Rest);
|
||||||
only_whitespace(Rest);
|
|
||||||
only_whitespace(<<$\t, Rest/binary>>) ->
|
|
||||||
only_whitespace(Rest);
|
|
||||||
only_whitespace(_) -> no.
|
only_whitespace(_) -> no.
|
||||||
|
|
||||||
get_text_value([]) -> <<>>;
|
get_text_value([]) -> [];
|
||||||
get_text_value([T | Rest]) when is_record(T, xmlText) ->
|
get_text_value([T|Rest]) when record(T, xmlText) ->
|
||||||
<<(list_to_binary(T#xmlText.value))/binary, (get_text_value(Rest))/binary>>;
|
T#xmlText.value++get_text_value(Rest);
|
||||||
get_text_value(_) -> throw({error, missing_text}).
|
get_text_value(_) -> throw({error, missing_text}).
|
||||||
|
|
||||||
decode_params([]) -> [];
|
decode_params([]) -> [];
|
||||||
decode_params(Content) ->
|
decode_params(Content) ->
|
||||||
case match_element(normal, [param], Content) of
|
case match_element(normal, [param], Content) of
|
||||||
{error, {missing_element, _}} -> [];
|
{error, {missing_element, _}} -> [];
|
||||||
{Param, Rest} ->
|
{Param, Rest} ->
|
||||||
{Value, _} = match_element([value],
|
{Value, _} = match_element([value], Param#xmlElement.content),
|
||||||
Param#xmlElement.content),
|
[decode(Value#xmlElement.content)|decode_params(Rest)]
|
||||||
[decode(Value#xmlElement.content) | decode_params(Rest)]
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
decode(Content) when is_list(Content) ->
|
decode(Content) when list(Content) ->
|
||||||
case get_value(Content) of
|
case get_value(Content) of
|
||||||
{text_value, TextValue} -> TextValue;
|
{text_value, TextValue} -> TextValue;
|
||||||
E -> decode(E)
|
E -> decode(E)
|
||||||
end;
|
end;
|
||||||
decode(String) when is_record(String, xmlText) ->
|
decode(String) when record(String, xmlText) -> String#xmlText.value;
|
||||||
String#xmlText.value;
|
|
||||||
decode(Struct) when Struct#xmlElement.name == struct ->
|
decode(Struct) when Struct#xmlElement.name == struct ->
|
||||||
{struct, decode_members(Struct#xmlElement.content)};
|
{struct, decode_members(Struct#xmlElement.content)};
|
||||||
decode(Array) when Array#xmlElement.name == array ->
|
decode(Array) when Array#xmlElement.name == array ->
|
||||||
{Data, _} = match_element([data],
|
{Data, _} = match_element([data], Array#xmlElement.content),
|
||||||
Array#xmlElement.content),
|
|
||||||
{array, decode_values(Data#xmlElement.content)};
|
{array, decode_values(Data#xmlElement.content)};
|
||||||
decode(Int)
|
decode(Int) when Int#xmlElement.name == int; Int#xmlElement.name == i4 ->
|
||||||
when Int#xmlElement.name == int;
|
|
||||||
Int#xmlElement.name == i4 ->
|
|
||||||
TextValue = get_text_value(Int#xmlElement.content),
|
TextValue = get_text_value(Int#xmlElement.content),
|
||||||
make_integer(TextValue);
|
make_integer(TextValue);
|
||||||
decode(Boolean)
|
decode(Boolean) when Boolean#xmlElement.name == boolean ->
|
||||||
when Boolean#xmlElement.name == boolean ->
|
|
||||||
case get_text_value(Boolean#xmlElement.content) of
|
case get_text_value(Boolean#xmlElement.content) of
|
||||||
<<"1">> -> true;
|
"1" -> true;
|
||||||
<<"0">> -> false;
|
"0" -> false;
|
||||||
TextValue ->
|
TextValue -> throw({error, {invalid_boolean, TextValue}})
|
||||||
throw({error, {invalid_boolean, TextValue}})
|
|
||||||
end;
|
end;
|
||||||
decode(String) when String#xmlElement.name == string ->
|
decode(String) when String#xmlElement.name == string ->
|
||||||
get_text_value(String#xmlElement.content);
|
get_text_value(String#xmlElement.content);
|
||||||
decode(Double) when Double#xmlElement.name == double ->
|
decode(Double) when Double#xmlElement.name == double ->
|
||||||
TextValue = get_text_value(Double#xmlElement.content),
|
TextValue = get_text_value(Double#xmlElement.content),
|
||||||
make_double(TextValue);
|
make_double(TextValue);
|
||||||
decode(Date)
|
decode(Date) when Date#xmlElement.name == 'dateTime.iso8601' ->
|
||||||
when Date#xmlElement.name == 'dateTime.iso8601' ->
|
|
||||||
TextValue = get_text_value(Date#xmlElement.content),
|
TextValue = get_text_value(Date#xmlElement.content),
|
||||||
{date, ensure_iso8601_date(TextValue)};
|
% {date, ensure_iso8601_date(TextValue)}; % FIXME
|
||||||
|
{date, TextValue};
|
||||||
decode(Base64) when Base64#xmlElement.name == base64 ->
|
decode(Base64) when Base64#xmlElement.name == base64 ->
|
||||||
TextValue = get_text_value(Base64#xmlElement.content),
|
TextValue = get_text_value(Base64#xmlElement.content),
|
||||||
{base64, ensure_base64(TextValue)};
|
% {base64, ensure_base64(TextValue)}; % FIXME
|
||||||
|
{base64, TextValue};
|
||||||
decode(Value) -> throw({error, {bad_value, Value}}).
|
decode(Value) -> throw({error, {bad_value, Value}}).
|
||||||
|
|
||||||
get_value(Content) ->
|
get_value(Content) ->
|
||||||
case any_element(Content) of
|
case any_element(Content) of
|
||||||
false -> {text_value, get_text_value(Content)};
|
false -> {text_value, get_text_value(Content)};
|
||||||
true -> get_element(Content)
|
true -> get_element(Content)
|
||||||
end.
|
end.
|
||||||
|
|
||||||
any_element([]) -> false;
|
any_element([]) -> false;
|
||||||
any_element([E | _]) when is_record(E, xmlElement) -> true;
|
any_element([E|_]) when record(E, xmlElement) -> true;
|
||||||
any_element([_ | Rest]) -> any_element(Rest).
|
any_element([_|Rest]) -> any_element(Rest).
|
||||||
|
|
||||||
get_element([]) -> throw({error, missing_element});
|
get_element([]) -> throw({error, missing_element});
|
||||||
get_element([E | _]) when is_record(E, xmlElement) -> E;
|
get_element([E|_]) when record(E, xmlElement) -> E;
|
||||||
get_element([T | Rest]) when is_record(T, xmlText) ->
|
get_element([T|Rest]) when record(T, xmlText) ->
|
||||||
case only_whitespace(T#xmlText.value) of
|
case only_whitespace(T#xmlText.value) of
|
||||||
yes -> get_element(Rest);
|
yes -> get_element(Rest);
|
||||||
no -> throw({error, {unexpected_text, T#xmlText.value}})
|
no -> throw({error, {unexpected_text, T#xmlText.value}})
|
||||||
end.
|
end.
|
||||||
|
|
||||||
decode_members(Content) ->
|
decode_members(Content) ->
|
||||||
case match_element(normal, [member], Content) of
|
case match_element(normal, [member], Content) of
|
||||||
{error, {missing_element, _}} -> [];
|
{error, {missing_element, _}} -> [];
|
||||||
{Member, Rest} ->
|
{Member, Rest} ->
|
||||||
{Name, Rest2} = match_element([name],
|
{Name, Rest2} = match_element([name], Member#xmlElement.content),
|
||||||
Member#xmlElement.content),
|
TextValue = get_text_value(Name#xmlElement.content),
|
||||||
TextValue = get_text_value(Name#xmlElement.content),
|
{Value, _} = match_element([value], Rest2),
|
||||||
{Value, _} = match_element([value], Rest2),
|
[{list_to_atom(TextValue),
|
||||||
[{jlib:binary_to_atom(TextValue),
|
decode(Value#xmlElement.content)}|decode_members(Rest)]
|
||||||
decode(Value#xmlElement.content)}
|
|
||||||
| decode_members(Rest)]
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
decode_values([]) -> [];
|
decode_values([]) -> [];
|
||||||
decode_values(Content) ->
|
decode_values(Content) ->
|
||||||
case match_element(normal, [value], Content) of
|
case match_element(normal, [value], Content) of
|
||||||
{error, {missing_element, _}} -> [];
|
{error, {missing_element, _}} -> [];
|
||||||
{Value, Rest} ->
|
{Value, Rest} ->
|
||||||
[decode(Value#xmlElement.content) | decode_values(Rest)]
|
[decode(Value#xmlElement.content)|decode_values(Rest)]
|
||||||
end.
|
end.
|
||||||
|
|
||||||
make_integer(Integer) ->
|
make_integer(Integer) ->
|
||||||
case catch jlib:binary_to_integer(Integer) of
|
case catch list_to_integer(Integer) of
|
||||||
{'EXIT', _Reason} ->
|
{'EXIT', _Reason} -> throw({error, {not_integer, Integer}});
|
||||||
throw({error, {not_integer, Integer}});
|
Value -> Value
|
||||||
Value -> Value
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
make_double(Double) ->
|
make_double(Double) ->
|
||||||
case catch list_to_float(binary_to_list(Double)) of
|
case catch list_to_float(Double) of
|
||||||
{'EXIT', _} -> throw({error, {not_double, Double}});
|
{'EXIT', _} ->
|
||||||
Value -> Value
|
case catch list_to_integer(Double) of
|
||||||
|
{'EXIT', _} ->
|
||||||
|
throw({error, {not_double, Double}});
|
||||||
|
Value -> float(Value)
|
||||||
|
end;
|
||||||
|
Value -> Value
|
||||||
end.
|
end.
|
||||||
|
|
||||||
ensure_iso8601_date(Date) ->
|
% FIXME
|
||||||
xmlrpc_util:is_iso8601_date(Date).
|
%ensure_iso8601_date(Date) ->
|
||||||
|
% case xmlrpc_util:is_iso8601_date(Date) of
|
||||||
ensure_base64(Base64) ->
|
% no -> throw({error, {not_iso8601_date, Date}});
|
||||||
xmlrpc_util:is_base64(Base64).
|
% yes -> Date
|
||||||
|
% end.
|
||||||
|
%
|
||||||
|
%ensure_base64(Base64) ->
|
||||||
|
% case xmlrpc_util:is_base64(Base64) of
|
||||||
|
% no -> throw({error, {not_base64, Base64}});
|
||||||
|
% yes -> Base64
|
||||||
|
% end.
|
||||||
|
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,103 +25,121 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(xmlrpc_encode).
|
-module(xmlrpc_encode).
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
|
||||||
-export([payload/1]).
|
-export([payload/1]).
|
||||||
|
|
||||||
%% Exported: payload/1
|
%% Exported: payload/1
|
||||||
|
|
||||||
-type xmlrpc() :: number() | boolean() | binary() |
|
payload({call, Name, Params}) when atom(Name), list(Params) ->
|
||||||
{base64, binary()} | {date, binary()} |
|
case encode_params(Params) of
|
||||||
{array, [xmlrpc()]} | {struct, [{atom(), xmlrpc()}]}.
|
{error, Reason} -> {error, Reason};
|
||||||
|
EncodedParams ->
|
||||||
|
EncodedPayload =
|
||||||
|
["<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?><methodCall><methodName>",
|
||||||
|
atom_to_list(Name), "</methodName>", EncodedParams,
|
||||||
|
"</methodCall>"],
|
||||||
|
{ok, EncodedPayload}
|
||||||
|
end;
|
||||||
|
payload({response, {fault, Code, String}}) when integer(Code) ->
|
||||||
|
case xmlrpc_util:is_string(String) of
|
||||||
|
yes ->
|
||||||
|
EncodedPayload =
|
||||||
|
["<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?><methodResponse><fault>"
|
||||||
|
"<value><struct><member><name>faultCode</name><value><int>",
|
||||||
|
integer_to_list(Code), "</int></value></member><member><name>"
|
||||||
|
"faultString</name><value><string>", escape_string(String),
|
||||||
|
"</string></value></member></struct></value></fault>",
|
||||||
|
"</methodResponse>"],
|
||||||
|
{ok, EncodedPayload};
|
||||||
|
no -> {error, {bad_string, String}}
|
||||||
|
end;
|
||||||
|
payload({response, []} = Payload) ->
|
||||||
|
{ok, ["<?xml version=\"1.0\"?><methodResponse></methodResponse>"]};
|
||||||
|
payload({response, [Param]} = Payload) ->
|
||||||
|
case encode_params([Param]) of
|
||||||
|
{error, Reason} -> {error, Reason};
|
||||||
|
EncodedParam ->
|
||||||
|
{ok, ["<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?><methodResponse>", EncodedParam,
|
||||||
|
"</methodResponse>"]}
|
||||||
|
end;
|
||||||
|
payload(Payload) -> {error, {bad_payload, Payload}}.
|
||||||
|
|
||||||
-spec payload({call, atom(), [xmlrpc()]} |
|
encode_params(Params) -> encode_params(Params, []).
|
||||||
{response, {fault, integer(), binary()} | [xmlrpc()]}) ->
|
|
||||||
binary().
|
|
||||||
|
|
||||||
payload({call, Name, Params}) ->
|
encode_params([], []) -> [];
|
||||||
<<"<?xml version=\"1.0\"?><methodCall><methodName>",
|
encode_params([], Acc) -> ["<params>", Acc, "</params>"];
|
||||||
(jlib:atom_to_binary(Name))/binary,
|
encode_params([Param|Rest], Acc) ->
|
||||||
"</methodName>",
|
case encode(Param) of
|
||||||
(encode_params(Params))/binary,
|
{error, Reason} -> {error, Reason};
|
||||||
"</methodCall>">>;
|
EncodedParam ->
|
||||||
payload({response, {fault, Code, String}}) ->
|
NewAcc = Acc++["<param><value>", EncodedParam, "</value></param>"],
|
||||||
<<"<?xml version=\"1.0\"?><methodResponse><fault"
|
encode_params(Rest, NewAcc)
|
||||||
"><value><struct><member><name>faultCode</name"
|
end.
|
||||||
"><value><int>",
|
|
||||||
(jlib:integer_to_binary(Code))/binary,
|
|
||||||
"</int></value></member><member><name>faultStr"
|
|
||||||
"ing</name><value><string>",
|
|
||||||
(escape_string(String))/binary,
|
|
||||||
"</string></value></member></struct></value></"
|
|
||||||
"fault></methodResponse>">>;
|
|
||||||
payload({response, []}) ->
|
|
||||||
<<"<?xml version=\"1.0\"?><methodResponse></methodResponse>">>;
|
|
||||||
payload({response, [Param]}) ->
|
|
||||||
<<"<?xml version=\"1.0\"?><methodResponse>",
|
|
||||||
(encode_params([Param]))/binary,
|
|
||||||
"</methodResponse>">>.
|
|
||||||
|
|
||||||
encode_params(Params) -> encode_params(Params, <<>>).
|
|
||||||
|
|
||||||
encode_params([], <<>>) -> <<>>;
|
|
||||||
encode_params([], Acc) ->
|
|
||||||
<<"<params>", Acc/binary, "</params>">>;
|
|
||||||
encode_params([Param | Rest], Acc) ->
|
|
||||||
EncodedParam = encode(Param),
|
|
||||||
NewAcc = <<Acc/binary, "<param><value>",
|
|
||||||
EncodedParam/binary, "</value></param>">>,
|
|
||||||
encode_params(Rest, NewAcc).
|
|
||||||
|
|
||||||
encode({struct, Struct}) ->
|
encode({struct, Struct}) ->
|
||||||
Members = encode_members(Struct),
|
case encode_members(Struct) of
|
||||||
<<"<struct>", Members/binary, "</struct>">>;
|
{error, Reason} -> {error, Reason};
|
||||||
encode({array, Array}) ->
|
Members -> ["<struct>", Members, "</struct>"]
|
||||||
Values = encode_values(Array),
|
end;
|
||||||
<<"<array><data>", Values/binary, "</data></array>">>;
|
encode({array, Array}) when list(Array) ->
|
||||||
encode(Integer) when is_integer(Integer) ->
|
case encode_values(Array)of
|
||||||
<<"<int>", (jlib:integer_to_binary(Integer))/binary, "</int>">>;
|
{error, Reason} -> {error, Reason};
|
||||||
encode(true) -> <<"<boolean>1</boolean>">>; % duh!
|
Values -> ["<array><data>", Values, "</data></array>"]
|
||||||
encode(false) -> <<"<boolean>0</boolean>">>; % duh!
|
end;
|
||||||
encode(Double) when is_float(Double) ->
|
encode(Integer) when integer(Integer) ->
|
||||||
list_to_binary(
|
["<int>", integer_to_list(Integer), "</int>"];
|
||||||
[<<"<double>">>, io_lib:format("~p", [Double]),
|
encode(true) -> "<boolean>1</boolean>"; % duh!
|
||||||
<<"</double>">>]);
|
encode(false) -> "<boolean>0</boolean>"; % duh!
|
||||||
|
encode(Double) when float(Double) ->
|
||||||
|
["<double>", io_lib:format("~p", [Double]), "</double>"];
|
||||||
encode({date, Date}) ->
|
encode({date, Date}) ->
|
||||||
<<"<dateTime.iso8601>", Date/binary, "</dateTime.iso8601>">>;
|
case xmlrpc_util:is_iso8601_date(Date) of
|
||||||
|
yes -> ["<dateTime.iso8601>", Date, "</dateTime.iso8601>"];
|
||||||
|
no -> {error, {bad_date, Date}}
|
||||||
|
end;
|
||||||
encode({base64, Base64}) ->
|
encode({base64, Base64}) ->
|
||||||
<<"<base64>", Base64/binary, "</base64>">>;
|
case xmlrpc_util:is_base64(Base64) of
|
||||||
|
yes -> ["<base64>", Base64, "</base64>"];
|
||||||
|
no -> {error, {bad_base64, Base64}}
|
||||||
|
end;
|
||||||
encode(Value) ->
|
encode(Value) ->
|
||||||
escape_string(Value).
|
case xmlrpc_util:is_string(Value) of
|
||||||
|
yes -> ["<string>", escape_string(Value), "</string>"];
|
||||||
|
no -> {error, {bad_value, Value}}
|
||||||
|
end.
|
||||||
|
|
||||||
escape_string(<<>>) -> <<>>;
|
escape_string([]) -> [];
|
||||||
escape_string(<<$<, Rest/binary>>) ->
|
escape_string([$<|Rest]) -> ["<", escape_string(Rest)];
|
||||||
<<"<", (escape_string(Rest))/binary>>;
|
escape_string([$>|Rest]) -> [">", escape_string(Rest)];
|
||||||
escape_string(<<$>, Rest/binary>>) ->
|
escape_string([$&|Rest]) -> ["&", escape_string(Rest)];
|
||||||
<<">", (escape_string(Rest))/binary>>;
|
escape_string([C|Rest]) -> [C|escape_string(Rest)].
|
||||||
escape_string(<<$&, Rest/binary>>) ->
|
|
||||||
<<"&", (escape_string(Rest))/binary>>;
|
|
||||||
escape_string(<<C, Rest/binary>>) -> <<C, (escape_string(Rest))/binary>>.
|
|
||||||
|
|
||||||
encode_members(Struct) -> encode_members(Struct, <<>>).
|
encode_members(Struct) -> encode_members(Struct, []).
|
||||||
|
|
||||||
encode_members([], Acc) -> Acc;
|
encode_members([], Acc) -> Acc;
|
||||||
encode_members([{Name, Value} | Rest], Acc) ->
|
encode_members([{Name, Value}|Rest], Acc) when atom(Name) ->
|
||||||
NewAcc = <<Acc/binary,
|
case encode(Value) of
|
||||||
"<member><name>",
|
{error, Reason} -> {error, Reason};
|
||||||
(jlib:atom_to_binary(Name))/binary,
|
EncodedValue ->
|
||||||
"</name><value>",
|
NewAcc =
|
||||||
(encode(Value))/binary,
|
Acc++["<member><name>", atom_to_list(Name), "</name><value>",
|
||||||
"</value></member>">>,
|
EncodedValue, "</value></member>"],
|
||||||
encode_members(Rest, NewAcc).
|
encode_members(Rest, NewAcc)
|
||||||
|
end;
|
||||||
|
encode_members([{Name, Value}|Rest], Acc) -> {error, {invalid_name, Name}};
|
||||||
|
encode_members(UnknownMember, Acc) ->
|
||||||
|
{error, {unknown_member, UnknownMember}}.
|
||||||
|
|
||||||
encode_values(Array) -> encode_values(Array, <<>>).
|
encode_values(Array) -> encode_values(Array, []).
|
||||||
|
|
||||||
encode_values([], Acc) -> Acc;
|
encode_values([], Acc) -> Acc;
|
||||||
encode_values([Value | Rest], Acc) ->
|
encode_values([Value|Rest], Acc) ->
|
||||||
NewAcc = <<Acc/binary,
|
case encode(Value) of
|
||||||
"<value>",
|
{error, Reason} -> {error, Reason};
|
||||||
(encode(Value))/binary,
|
EncodedValue ->
|
||||||
"</value>">>,
|
NewAcc = Acc++["<value>", EncodedValue, "</value>"],
|
||||||
encode_values(Rest, NewAcc).
|
encode_values(Rest, NewAcc)
|
||||||
|
end;
|
||||||
|
encode_values([{Name, Value}|Rest], Acc) -> {error, {invalid_name, Name}};
|
||||||
|
encode_values(UnknownMember, Acc) ->
|
||||||
|
{error, {unknown_member, UnknownMember}}.
|
||||||
|
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,192 +25,206 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(xmlrpc_http).
|
-module(xmlrpc_http).
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
|
||||||
-export([handler/4]).
|
-export([handler/4]).
|
||||||
|
|
||||||
-include("log.hrl").
|
-include("log.hrl").
|
||||||
|
|
||||||
-record(header,
|
-include("xmlrpc.hrl").
|
||||||
{content_length :: non_neg_integer(),
|
|
||||||
content_type :: binary(),
|
|
||||||
user_agent :: binary(),
|
|
||||||
connection :: close}).
|
|
||||||
|
|
||||||
%% Exported: handler/3
|
%% Exported: handler/4
|
||||||
|
|
||||||
handler(Socket, Timeout, Handler, State) ->
|
handler(Socket, Timeout, Handler, State) ->
|
||||||
case parse_request(Socket, Timeout) of
|
case parse_request(Socket, Timeout) of
|
||||||
{ok, Header} ->
|
{ok, Header} ->
|
||||||
?DEBUG_LOG({header, Header}),
|
?DEBUG_LOG({header, Header}),
|
||||||
handle_payload(Socket, Timeout, Handler, State, Header);
|
handle_payload(Socket, Timeout, Handler, State, Header);
|
||||||
{status, StatusCode} ->
|
{status, StatusCode} ->
|
||||||
send(Socket, StatusCode),
|
send(Socket, StatusCode),
|
||||||
handler(Socket, Timeout, Handler, State);
|
handler(Socket, Timeout, Handler, State);
|
||||||
{error, Reason} -> {error, Reason}
|
{error, Reason} -> {error, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
parse_request(Socket, Timeout) ->
|
parse_request(Socket, Timeout) ->
|
||||||
inet:setopts(Socket, [{packet, line}]),
|
inet:setopts(Socket, [{packet, line}]),
|
||||||
case gen_tcp:recv(Socket, 0, Timeout) of
|
case gen_tcp:recv(Socket, 0, Timeout) of
|
||||||
{ok, RequestLine} ->
|
{ok, RequestLine} ->
|
||||||
case str:tokens(RequestLine, <<" \r\n">>) of
|
case string:tokens(RequestLine, " \r\n") of
|
||||||
[<<"POST">>, _, <<"HTTP/1.0">>] ->
|
["POST", _, "HTTP/1.0"] ->
|
||||||
?DEBUG_LOG({http_version, <<"1.0">>}),
|
?DEBUG_LOG({http_version, "1.0"}),
|
||||||
parse_header(Socket, Timeout,
|
parse_header(Socket, Timeout, #header{connection = close});
|
||||||
#header{connection = close});
|
["POST", _, "HTTP/1.1"] ->
|
||||||
[<<"POST">>, _, <<"HTTP/1.1">>] ->
|
?DEBUG_LOG({http_version, "1.1"}),
|
||||||
?DEBUG_LOG({http_version, <<"1.1">>}),
|
parse_header(Socket, Timeout);
|
||||||
parse_header(Socket, Timeout);
|
[_Method, _, "HTTP/1.1"] -> {status, 501};
|
||||||
[_Method, _, <<"HTTP/1.1">>] -> {status, 501};
|
["POST", _, _HTTPVersion] -> {status, 505};
|
||||||
[<<"POST">>, _, _HTTPVersion] -> {status, 505};
|
_ -> {status, 400}
|
||||||
_ -> {status, 400}
|
end;
|
||||||
end;
|
{error, Reason} -> {error, Reason}
|
||||||
{error, Reason} -> {error, Reason}
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
parse_header(Socket, Timeout) ->
|
parse_header(Socket, Timeout) -> parse_header(Socket, Timeout, #header{}).
|
||||||
parse_header(Socket, Timeout, #header{}).
|
|
||||||
|
|
||||||
parse_header(Socket, Timeout, Header) ->
|
parse_header(Socket, Timeout, Header) ->
|
||||||
case gen_tcp:recv(Socket, 0, Timeout) of
|
case gen_tcp:recv(Socket, 0, Timeout) of
|
||||||
{ok, <<"\r\n">>}
|
{ok, "\r\n"} when Header#header.content_length == undefined ->
|
||||||
when Header#header.content_length == undefined ->
|
{status, 411};
|
||||||
{status, 411};
|
{ok, "\r\n"} when Header#header.content_type == undefined ->
|
||||||
{ok, <<"\r\n">>}
|
{status, 400};
|
||||||
when Header#header.content_type == undefined ->
|
{ok, "\r\n"} when Header#header.user_agent == undefined ->
|
||||||
{status, 400};
|
{status, 400};
|
||||||
{ok, <<"\r\n">>}
|
{ok, "\r\n"} -> {ok, Header};
|
||||||
when Header#header.user_agent == undefined ->
|
{ok, HeaderField} ->
|
||||||
{status, 400};
|
case split_header_field(HeaderField) of
|
||||||
{ok, <<"\r\n">>} -> {ok, Header};
|
{[$C,$o,$n,$t,$e,$n,$t,$-,_,$e,$n,$g,$t,$h,$:],
|
||||||
{ok, HeaderField} ->
|
ContentLength} ->
|
||||||
case split_header_field(HeaderField) of
|
case catch list_to_integer(ContentLength) of
|
||||||
{<<"Content-", _, "ength:">>, ContentLength} ->
|
N ->
|
||||||
case catch jlib:binary_to_integer(ContentLength) of
|
parse_header(Socket, Timeout,
|
||||||
N when is_integer(N), N>=0 ->
|
Header#header{content_length = N});
|
||||||
parse_header(Socket, Timeout,
|
_ -> {status, 400}
|
||||||
Header#header{content_length = N});
|
end;
|
||||||
_ -> {status, 400}
|
{"Content-Type:", "text/xml"} ->
|
||||||
end;
|
parse_header(Socket, Timeout,
|
||||||
{<<"Content-Type:">>, <<"text/xml">>} ->
|
Header#header{content_type = "text/xml"});
|
||||||
parse_header(Socket, Timeout,
|
{"Content-Type:", "text/xml; charset=utf-8"} ->
|
||||||
Header#header{content_type = <<"text/xml">>});
|
parse_header(Socket, Timeout,
|
||||||
{<<"Content-Type:">>, <<"text/xml; charset=utf-8">>} ->
|
Header#header{content_type = "text/xml; charset=utf-8"});
|
||||||
parse_header(Socket, Timeout,
|
{"Content-Type:", _ContentType} -> {status, 415};
|
||||||
Header#header{content_type =
|
{"User-Agent:", UserAgent} ->
|
||||||
<<"text/xml; charset=utf-8">>});
|
parse_header(Socket, Timeout,
|
||||||
{<<"Content-Type:">>, _ContentType} -> {status, 415};
|
Header#header{user_agent = UserAgent});
|
||||||
{<<"User-Agent:">>, UserAgent} ->
|
{"Connection:", "close"} ->
|
||||||
parse_header(Socket, Timeout,
|
parse_header(Socket, Timeout,
|
||||||
Header#header{user_agent = UserAgent});
|
Header#header{connection = close});
|
||||||
{<<"Connection:">>, <<"close">>} ->
|
{"Connection:", [_,$e,$e,$p,$-,_,$l,$i,$v,$e]} ->
|
||||||
parse_header(Socket, Timeout,
|
parse_header(Socket, Timeout,
|
||||||
Header#header{connection = close});
|
Header#header{connection = undefined});
|
||||||
{<<"Connection:">>, <<_, "eep-", _, "live">>} ->
|
{"Authorization:", Authorization} ->
|
||||||
parse_header(Socket, Timeout,
|
parse_header(Socket, Timeout,
|
||||||
Header#header{connection = undefined});
|
Header#header{authorization = Authorization});
|
||||||
_ ->
|
{"Cookie:", Cookie} ->
|
||||||
?DEBUG_LOG({skipped_header, HeaderField}),
|
Cookies = [ Cookie | Header#header.cookies ],
|
||||||
parse_header(Socket, Timeout, Header)
|
parse_header(Socket, Timeout,
|
||||||
end;
|
Header#header{cookies = Cookies});
|
||||||
{error, Reason} -> {error, Reason}
|
_ ->
|
||||||
|
?DEBUG_LOG({skipped_header, HeaderField}),
|
||||||
|
parse_header(Socket, Timeout, Header)
|
||||||
|
end;
|
||||||
|
{error, Reason} -> {error, Reason}
|
||||||
end.
|
end.
|
||||||
|
|
||||||
split_header_field(HeaderField) ->
|
split_header_field(HeaderField) -> split_header_field(HeaderField, []).
|
||||||
split_header_field(binary_to_list(HeaderField), []).
|
|
||||||
|
|
||||||
split_header_field([], Name) -> {list_to_binary(Name), <<"">>};
|
split_header_field([], Name) -> {Name, ""};
|
||||||
split_header_field([$\s | Rest], Name) ->
|
split_header_field([$ |Rest], Name) -> {lists:reverse(Name), Rest -- "\r\n"};
|
||||||
{list_to_binary(lists:reverse(Name)),
|
split_header_field([C|Rest], Name) -> split_header_field(Rest, [C|Name]).
|
||||||
list_to_binary(Rest -- "\r\n")};
|
|
||||||
split_header_field([C | Rest], Name) ->
|
|
||||||
split_header_field(Rest, [C | Name]).
|
|
||||||
|
|
||||||
handle_payload(Socket, Timeout, Handler, State,
|
handle_payload(Socket, Timeout, Handler, State,
|
||||||
#header{connection = Connection} = Header) ->
|
#header{connection = Connection} = Header) ->
|
||||||
case get_payload(Socket, Timeout,
|
case get_payload(Socket, Timeout, Header#header.content_length) of
|
||||||
Header#header.content_length)
|
{ok, Payload} ->
|
||||||
of
|
?DEBUG_LOG({encoded_call, Payload}),
|
||||||
{ok, Payload} ->
|
case xmlrpc_decode:payload(Payload) of
|
||||||
?DEBUG_LOG({encoded_call, Payload}),
|
{ok, DecodedPayload} ->
|
||||||
case xmlrpc_decode:payload(Payload) of
|
?DEBUG_LOG({decoded_call, DecodedPayload}),
|
||||||
{ok, DecodedPayload} ->
|
eval_payload(Socket, Timeout, Handler, State, Connection,
|
||||||
?DEBUG_LOG({decoded_call, DecodedPayload}),
|
DecodedPayload, Header);
|
||||||
eval_payload(Socket, Timeout, Handler, State,
|
{error, Reason} when Connection == close ->
|
||||||
Connection, DecodedPayload);
|
?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}),
|
||||||
{error, Reason} when Connection == close ->
|
send(Socket, 400);
|
||||||
?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}),
|
{error, Reason} ->
|
||||||
send(Socket, 400);
|
?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}),
|
||||||
{error, Reason} ->
|
send(Socket, 400),
|
||||||
?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}),
|
handler(Socket, Timeout, Handler, State)
|
||||||
send(Socket, 400),
|
end;
|
||||||
handler(Socket, Timeout, Handler, State)
|
{error, Reason} -> {error, Reason}
|
||||||
end;
|
|
||||||
{error, Reason} -> {error, Reason}
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
get_payload(Socket, Timeout, ContentLength) ->
|
get_payload(Socket, Timeout, ContentLength) ->
|
||||||
inet:setopts(Socket, [binary, {packet, raw}]),
|
inet:setopts(Socket, [{packet, raw}]),
|
||||||
gen_tcp:recv(Socket, ContentLength, Timeout).
|
gen_tcp:recv(Socket, ContentLength, Timeout).
|
||||||
|
|
||||||
eval_payload(Socket, Timeout, {M, F} = Handler, State,
|
%% Check whether module has defined new function
|
||||||
Connection, Payload) ->
|
%% M:F(State, Payload, Header)
|
||||||
case catch M:F(State, Payload) of
|
has_newcall(M, F) ->
|
||||||
{'EXIT', Reason} when Connection == close ->
|
erlang:function_exported(M, F, 3).
|
||||||
?ERROR_LOG({M, F, {'EXIT', Reason}}),
|
|
||||||
send(Socket, 500, <<"Connection: close\r\n">>);
|
%% Handle module call
|
||||||
{'EXIT', Reason} ->
|
do_call({M, F} = _Handler, State, Payload, Header) ->
|
||||||
?ERROR_LOG({M, F, {'EXIT', Reason}}),
|
case has_newcall(M, F) of
|
||||||
send(Socket, 500),
|
true ->
|
||||||
handler(Socket, Timeout, Handler, State);
|
M:F(State, Payload, Header);
|
||||||
{error, Reason} when Connection == close ->
|
false ->
|
||||||
?ERROR_LOG({M, F, Reason}),
|
M:F(State, Payload)
|
||||||
send(Socket, 500, <<"Connection: close\r\n">>);
|
end.
|
||||||
{error, Reason} ->
|
|
||||||
?ERROR_LOG({M, F, Reason}),
|
eval_payload(Socket, Timeout, {M, F} = Handler, State, Connection, Payload, Header) ->
|
||||||
send(Socket, 500),
|
case catch do_call(Handler, State, Payload, Header) of
|
||||||
handler(Socket, Timeout, Handler, State);
|
{'EXIT', Reason} when Connection == close ->
|
||||||
{false, ResponsePayload} ->
|
?ERROR_LOG({M, F, {'EXIT', Reason}}),
|
||||||
encode_send(Socket, 200, <<"Connection: close\r\n">>,
|
send(Socket, 500, "Connection: close\r\n");
|
||||||
ResponsePayload);
|
{'EXIT', Reason} ->
|
||||||
{true, _NewTimeout, _NewState, ResponsePayload}
|
?ERROR_LOG({M, F, {'EXIT', Reason}}),
|
||||||
when Connection == close ->
|
send(Socket, 500),
|
||||||
encode_send(Socket, 200, <<"Connection: close\r\n">>,
|
handler(Socket, Timeout, Handler, State);
|
||||||
ResponsePayload);
|
{error, Reason} when Connection == close ->
|
||||||
{true, NewTimeout, NewState, ResponsePayload} ->
|
?ERROR_LOG({M, F, Reason}),
|
||||||
encode_send(Socket, 200, <<"">>, ResponsePayload),
|
send(Socket, 500, "Connection: close\r\n");
|
||||||
handler(Socket, NewTimeout, Handler, NewState)
|
{error, Reason} ->
|
||||||
|
?ERROR_LOG({M, F, Reason}),
|
||||||
|
send(Socket, 500),
|
||||||
|
handler(Socket, Timeout, Handler, State);
|
||||||
|
{false, ResponsePayload} ->
|
||||||
|
encode_send(Socket, 200, "Connection: close\r\n", ResponsePayload);
|
||||||
|
{false, ResponsePayload, ExtraHeaders} ->
|
||||||
|
encode_send(Socket, 200, [ExtraHeaders, "Connection: close\r\n"], ResponsePayload);
|
||||||
|
{true, _NewTimeout, _NewState, ResponsePayload} when
|
||||||
|
Connection == close ->
|
||||||
|
encode_send(Socket, 200, "Connection: close\r\n", ResponsePayload);
|
||||||
|
{true, NewTimeout, NewState, ResponsePayload} ->
|
||||||
|
encode_send(Socket, 200, "", ResponsePayload),
|
||||||
|
handler(Socket, NewTimeout, Handler, NewState);
|
||||||
|
{true, _NewTimeout, _NewState, ResponsePayload, ExtraHeaders} when
|
||||||
|
Connection == close ->
|
||||||
|
encode_send(Socket, 200, [ExtraHeaders, "Connection: close\r\n"], ResponsePayload);
|
||||||
|
{true, NewTimeout, NewState, ResponsePayload, ExtraHeaders} ->
|
||||||
|
encode_send(Socket, 200, ExtraHeaders, ResponsePayload),
|
||||||
|
handler(Socket, NewTimeout, Handler, NewState)
|
||||||
end.
|
end.
|
||||||
|
|
||||||
encode_send(Socket, StatusCode, ExtraHeader, Payload) ->
|
encode_send(Socket, StatusCode, ExtraHeader, Payload) ->
|
||||||
?DEBUG_LOG({decoded_response, Payload}),
|
?DEBUG_LOG({decoded_response, Payload}),
|
||||||
EncodedPayload = xmlrpc_encode:payload(Payload),
|
case xmlrpc_encode:payload(Payload) of
|
||||||
?DEBUG_LOG({encoded_response, EncodedPayload}),
|
{ok, EncodedPayload} ->
|
||||||
send(Socket, StatusCode, ExtraHeader, EncodedPayload).
|
?DEBUG_LOG({encoded_response, lists:flatten(EncodedPayload)}),
|
||||||
|
send(Socket, StatusCode, ExtraHeader, EncodedPayload);
|
||||||
|
{error, Reason} ->
|
||||||
|
?ERROR_LOG({xmlrpc_encode, payload, Payload, Reason}),
|
||||||
|
send(Socket, 500)
|
||||||
|
end.
|
||||||
|
|
||||||
send(Socket, StatusCode) ->
|
send(Socket, StatusCode) -> send(Socket, StatusCode, "", "").
|
||||||
send(Socket, StatusCode, <<"">>, <<"">>).
|
|
||||||
|
|
||||||
send(Socket, StatusCode, ExtraHeader) ->
|
send(Socket, StatusCode, ExtraHeader) ->
|
||||||
send(Socket, StatusCode, ExtraHeader, <<"">>).
|
send(Socket, StatusCode, ExtraHeader, "").
|
||||||
|
|
||||||
send(Socket, StatusCode, ExtraHeader, Payload) ->
|
send(Socket, StatusCode, ExtraHeader, Payload) ->
|
||||||
Response = [<<"HTTP/1.1 ">>,
|
Response =
|
||||||
jlib:integer_to_binary(StatusCode), <<" ">>,
|
["HTTP/1.1 ", integer_to_list(StatusCode), " ",
|
||||||
reason_phrase(StatusCode), <<"\r\n">>,
|
reason_phrase(StatusCode), "\r\n",
|
||||||
<<"Content-Length: ">>,
|
"Content-Length: ", integer_to_list(lists:flatlength(Payload)),
|
||||||
jlib:integer_to_binary(byte_size(Payload)),
|
"\r\n",
|
||||||
<<"\r\n">>, <<"Server: Erlang/1.13\r\n">>,
|
"Server: Erlang/1.13\r\n",
|
||||||
<<"Content-Type: text/xml\r\n">>, ExtraHeader,
|
"Content-Type: text/xml\r\n",
|
||||||
<<"\r\n">>, Payload],
|
ExtraHeader, "\r\n",
|
||||||
|
Payload],
|
||||||
gen_tcp:send(Socket, Response).
|
gen_tcp:send(Socket, Response).
|
||||||
|
|
||||||
reason_phrase(200) -> <<"OK">>;
|
reason_phrase(200) -> "OK";
|
||||||
reason_phrase(400) -> <<"Bad Request">>;
|
reason_phrase(400) -> "Bad Request";
|
||||||
reason_phrase(411) -> <<"Length required">>;
|
reason_phrase(411) -> "Length required";
|
||||||
reason_phrase(415) -> <<"Unsupported Media Type">>;
|
reason_phrase(415) -> "Unsupported Media Type";
|
||||||
reason_phrase(500) -> <<"Internal Server Error">>;
|
reason_phrase(500) -> "Internal Server Error";
|
||||||
reason_phrase(501) -> <<"Not Implemented">>;
|
reason_phrase(501) -> "Not Implemented";
|
||||||
reason_phrase(505) -> <<"HTTP Version not supported">>.
|
reason_phrase(505) -> "HTTP Version not supported".
|
||||||
|
@ -3,10 +3,10 @@
|
|||||||
%%
|
%%
|
||||||
%% Redistribution and use in source and binary forms, with or without
|
%% Redistribution and use in source and binary forms, with or without
|
||||||
%% modification, are permitted provided that the following conditions
|
%% modification, are permitted provided that the following conditions
|
||||||
%% are met:
|
%% are met:
|
||||||
%%
|
%%
|
||||||
%% 1. Redistributions of source code must retain the above copyright
|
%% 1. Redistributions of source code must retain the above copyright
|
||||||
%% notice, this list of conditions and the following disclaimer.
|
%% notice, this list of conditions and the following disclaimer.
|
||||||
%% 2. Redistributions in binary form must reproduce the above
|
%% 2. Redistributions in binary form must reproduce the above
|
||||||
%% copyright notice, this list of conditions and the following
|
%% copyright notice, this list of conditions and the following
|
||||||
%% disclaimer in the documentation and/or other materials provided
|
%% disclaimer in the documentation and/or other materials provided
|
||||||
@ -25,18 +25,13 @@
|
|||||||
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
-module(xmlrpc_util).
|
-module(xmlrpc_util).
|
||||||
|
|
||||||
-author('jocke@gleipnir.com').
|
-author('jocke@gleipnir.com').
|
||||||
|
|
||||||
-export([is_string/1, is_iso8601_date/1, is_base64/1]).
|
-export([is_string/1, is_iso8601_date/1, is_base64/1]).
|
||||||
|
|
||||||
is_string(String) when is_binary(String) -> yes;
|
is_string([C|Rest]) when C >= 0, C =< 255 -> is_string(Rest);
|
||||||
|
is_string([]) -> yes;
|
||||||
is_string(_) -> no.
|
is_string(_) -> no.
|
||||||
|
|
||||||
-spec is_iso8601_date(binary()) -> yes.
|
is_iso8601_date(_) -> yes. % FIXME
|
||||||
|
|
||||||
is_iso8601_date(_) -> yes.
|
is_base64(_) -> yes. % FIXME
|
||||||
|
|
||||||
-spec is_base64(binary()) -> yes.
|
|
||||||
|
|
||||||
is_base64(_) -> yes.
|
|
||||||
|
Loading…
Reference in New Issue
Block a user