From c9ac75474f945e698b90a27614921d2057d72934 Mon Sep 17 00:00:00 2001 From: Badlop Date: Tue, 20 Nov 2012 12:43:54 +0100 Subject: [PATCH] Update to xmlrpc-rds13 Cloned from https://github.com/rds13/xmlrpc --- src/beam_util.erl | 56 +++++++ src/log.hrl | 11 +- src/tcp_serv.erl | 156 +++++++++--------- src/url_util.erl | 65 ++++++++ src/xmlrpc.app | 9 ++ src/xmlrpc.app.src | 8 + src/xmlrpc.erl | 359 ++++++++++++++++++++++++++---------------- src/xmlrpc.hrl | 41 +++++ src/xmlrpc_decode.erl | 259 ++++++++++++++---------------- src/xmlrpc_encode.erl | 184 ++++++++++++---------- src/xmlrpc_http.erl | 314 ++++++++++++++++++------------------ src/xmlrpc_util.erl | 17 +- 12 files changed, 880 insertions(+), 599 deletions(-) create mode 100644 src/beam_util.erl create mode 100644 src/url_util.erl create mode 100644 src/xmlrpc.app create mode 100644 src/xmlrpc.app.src create mode 100644 src/xmlrpc.hrl diff --git a/src/beam_util.erl b/src/beam_util.erl new file mode 100644 index 000000000..5104ca285 --- /dev/null +++ b/src/beam_util.erl @@ -0,0 +1,56 @@ +%% Copyright (C) 2009 Romuald du Song . +%% 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. diff --git a/src/log.hrl b/src/log.hrl index e737fa4c5..0f025e570 100644 --- a/src/log.hrl +++ b/src/log.hrl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -31,13 +31,8 @@ error_logger:error_report({?MODULE, ?LINE, Reason})). -ifdef(DEBUG). - -define(DEBUG_LOG(Reason), - error_logger:info_report({debug, ?MODULE, ?LINE, - Reason})). - + error_logger:info_report({debug, ?MODULE, ?LINE, Reason})). -else. - -define(DEBUG_LOG(Reason), ok). - -endif. diff --git a/src/tcp_serv.erl b/src/tcp_serv.erl index 7607647ec..51e00dcc3 100644 --- a/src/tcp_serv.erl +++ b/src/tcp_serv.erl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,34 +25,41 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(tcp_serv). - -vsn("1.13"). - -author('jocke@gleipnir.com'). - -export([start_link/1, start_link/2, stop/1, stop/2]). - -export([init/2, start_session/3]). - -export([system_continue/3, system_terminate/4]). -include("log.hrl"). --record(state, - {max_sessions, session_handler, session_list, - listen_socket, parent, debug_info}). +-record(state, { + %% int() + 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} start_link(Args) -> start_link(Args, 60000). - + start_link(Args, Timeout) -> - Pid = proc_lib:spawn_link(?MODULE, init, - [self(), Args]), + Pid = proc_lib:spawn_link(?MODULE, init, [self(), Args]), receive - {Pid, started} -> {ok, Pid}; - {Pid, Reason} -> {error, Reason} - after Timeout -> {error, timeout} + {Pid, started} -> {ok, Pid}; + {Pid, Reason} -> {error, Reason} + after Timeout -> {error, timeout} end. %% Exported: stop/{1,2} @@ -60,83 +67,90 @@ start_link(Args, Timeout) -> stop(Pid) -> stop(Pid, 15000). stop(Pid, Timeout) -> - Pid ! {self(), stop}, + Pid ! {self(), stop}, receive - {Pid, Reply} -> Reply after Timeout -> {error, timeout} + {Pid, Reply} -> Reply + after + Timeout -> {error, timeout} end. %% Exported: init/2 -init(Parent, - [Port, MaxSessions, OptionList, SessionHandler]) -> +init(Parent, [Port, MaxSessions, OptionList, SessionHandler]) -> process_flag(trap_exit, true), case gen_tcp:listen(Port, OptionList) of - {ok, ListenSocket} -> - self() ! start_session, - Parent ! {self(), started}, - loop(#state{max_sessions = MaxSessions, - session_handler = SessionHandler, session_list = [], - listen_socket = ListenSocket, parent = Parent}); - Reason -> Parent ! {self(), {not_started, Reason}} + {ok, ListenSocket} -> + self() ! start_session, + Parent ! {self(), started}, + loop(#state{max_sessions = MaxSessions, + session_handler = SessionHandler, + session_list = [], + listen_socket = ListenSocket, + parent = Parent}); + Reason -> Parent ! {self(), {not_started, Reason}} end. -loop(#state{session_list = SessionList, - listen_socket = ListenSocket, parent = Parent} = - State) -> +loop(#state{session_list = SessionList, listen_socket = ListenSocket, + parent = Parent} = State) -> receive - {From, stop} -> cleanup(State), From ! {self(), ok}; - start_session - when length(SessionList) > State#state.max_sessions -> - timer:sleep(5000), self() ! start_session, loop(State); - start_session -> - A = [self(), State#state.session_handler, ListenSocket], - Pid = proc_lib:spawn_link(?MODULE, start_session, A), - loop(State#state{session_list = [Pid | SessionList]}); - {'EXIT', Parent, Reason} -> - cleanup(State), exit(Reason); - {'EXIT', Pid, Reason} -> - case lists:member(Pid, SessionList) of - true -> - PurgedSessionList = lists:delete(Pid, SessionList), - loop(State#state{session_list = PurgedSessionList}); - false -> - ?ERROR_LOG({ignoring, {'EXIT', Pid, Reason}}), - loop(State) - end; - {system, From, Request} -> - sys:handle_system_msg(Request, From, Parent, ?MODULE, - State#state.debug_info, State); - UnknownMessage -> - ?ERROR_LOG({unknown_message, UnknownMessage}), - loop(State) + {From, stop} -> + cleanup(State), + From ! {self(), ok}; + start_session when length(SessionList) > State#state.max_sessions -> + timer:sleep(5000), + self() ! start_session, + loop(State); + start_session -> + A = [self(), State#state.session_handler, ListenSocket], + Pid = proc_lib:spawn_link(?MODULE, start_session, A), + loop(State#state{session_list = [Pid|SessionList]}); + {'EXIT', Parent, Reason} -> + cleanup(State), + exit(Reason); + {'EXIT', Pid, Reason} -> + case lists:member(Pid, SessionList) of + true -> + PurgedSessionList = lists:delete(Pid, SessionList), + loop(State#state{session_list = PurgedSessionList}); + false -> + ?ERROR_LOG({ignoring, {'EXIT', Pid, Reason}}), + loop(State) + end; + {system, From, Request} -> + sys:handle_system_msg(Request, From, Parent, ?MODULE, + State#state.debug_info, State); + UnknownMessage -> + ?ERROR_LOG({unknown_message, UnknownMessage}), + loop(State) end. -cleanup(State) -> - gen_tcp:close(State#state.listen_socket). +cleanup(State) -> gen_tcp:close(State#state.listen_socket). %% Exported: start_seesion/3 start_session(Parent, {M, F, A}, ListenSocket) -> case gen_tcp:accept(ListenSocket) of - {ok, Socket} -> - Parent ! start_session, - case apply(M, F, [Socket | A]) of - ok -> gen_tcp:close(Socket); - {error, closed} -> ok; - {error, Reason} -> - ?ERROR_LOG({M, F, Reason}), gen_tcp:close(Socket) - end; - {error, _Reason} -> - timer:sleep(5000), Parent ! start_session + {ok, Socket} -> + Parent ! start_session, + case apply(M, F, [Socket|A]) of + ok -> gen_tcp:close(Socket); + {error, closed} -> ok; + {error, Reason} -> + ?ERROR_LOG({M, F, Reason}), + gen_tcp:close(Socket) + end; + {error, Reason} -> + timer:sleep(5000), + Parent ! start_session end. %% Exported: system_continue/3 system_continue(Parent, DebugInfo, State) -> - loop(State#state{parent = Parent, - debug_info = DebugInfo}). + loop(State#state{parent = Parent, debug_info = DebugInfo}). %% Exported: system_terminate/3 -system_terminate(Reason, _Parent, _DebugInfo, State) -> - cleanup(State), exit(Reason). +system_terminate(Reason, Parent, DebugInfo, State) -> + cleanup(State), + exit(Reason). diff --git a/src/url_util.erl b/src/url_util.erl new file mode 100644 index 000000000..64140321b --- /dev/null +++ b/src/url_util.erl @@ -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. diff --git a/src/xmlrpc.app b/src/xmlrpc.app new file mode 100644 index 000000000..2a3642ca9 --- /dev/null +++ b/src/xmlrpc.app @@ -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]}]}. diff --git a/src/xmlrpc.app.src b/src/xmlrpc.app.src new file mode 100644 index 000000000..9af3e4117 --- /dev/null +++ b/src/xmlrpc.app.src @@ -0,0 +1,8 @@ +{application, xmlrpc, + [ + {description, ""}, + {vsn, git}, + {registered, []}, + {applications, []}, + {env, []} + ]}. diff --git a/src/xmlrpc.erl b/src/xmlrpc.erl index 009a8001d..faa579733 100644 --- a/src/xmlrpc.erl +++ b/src/xmlrpc.erl @@ -1,12 +1,14 @@ +%% Hacked by Romuald du Song +%% %% Copyright (C) 2003 Joakim Grebenö . %% All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,163 +27,244 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(xmlrpc). - -author('jocke@gleipnir.com'). - --export([call/3, call/4, call/5, call/6]). - --export([start_link/1, start_link/5, start_link/6, - stop/1]). +-export([call/3, call/4, call/5, call/6, call/7, call/8, call2/7]). +-export([start_link/1, start_link/5, start_link/6, stop/1]). -include("log.hrl"). --record(header, {content_length :: non_neg_integer(), - connection :: close}). +-include("xmlrpc.hrl"). -%% Exported: call/{3,4,5,6} - -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. +%% Exported: call/{3,4,5,6,7,8} 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) -> - ?DEBUG_LOG({decoded_call, Payload}), - EncodedPayload = xmlrpc_encode:payload(Payload), - ?DEBUG_LOG({encoded_call, EncodedPayload}), - case send(Socket, URI, KeepAlive, EncodedPayload) of - ok -> - case parse_response(Socket, Timeout) of - {ok, Header} -> - handle_payload(Socket, KeepAlive, Timeout, Header); - {error, Reason} when KeepAlive == false -> - gen_tcp:close(Socket), {error, Reason}; - {error, Reason} -> {error, Socket, Reason} - end; - {error, Reason} when KeepAlive == false -> - gen_tcp:close(Socket), {error, Reason}; - {error, Reason} -> {error, Socket, Reason} + call2(Socket, URI, Payload, KeepAlive, Timeout, "", [{ssl, false}, {header, false}]). + +call(Host, Port, URI, Payload) when is_number(Port) -> + call(Host, Port, URI, Payload, false, 60000, "", [{ssl, false}, {header, false}]); + +call(Socket, URI, Payload, Options) -> + call2(Socket, URI, Payload, false, 60000, "", Options). + +call(Host, Port, URI, Payload, KeepAlive, Timeout) when is_number(Port) -> + call(Host, Port, URI, Payload, KeepAlive, Timeout, "", [{ssl, false}, {header, false}]); + +call(Socket, URI, Payload, KeepAlive, Timeout, Options) -> + call2(Socket, URI, Payload, KeepAlive, Timeout, "", Options). + +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. -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) -> - inet:setopts(Socket, [binary, {packet, line}]), - case gen_tcp:recv(Socket, 0, Timeout) of - {ok, <<"HTTP/1.1 200 OK\r\n">>} -> - parse_header(Socket, Timeout); - {ok, StatusLine} -> {error, StatusLine}; - {error, Reason} -> {error, Reason} +open_socket(Host, Port, Options) -> + case fetch_comm_module(Options) of + ssl -> + %% Start ssl application + application:start(ssl), + %% Always seed + 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. -parse_header(Socket, Timeout) -> - parse_header(Socket, Timeout, #header{}). - -parse_header(Socket, Timeout, Header) -> - case gen_tcp: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 str:tokens(HeaderField, <<" \r\n">>) of - [<<"Content-Length:">>, ContentLength] -> - case catch jlib:binary_to_integer(ContentLength) of - Value when is_integer(Value), Value>=0 -> - parse_header(Socket, Timeout, - Header#header{content_length = Value}); - _ -> - {error, {invalid_content_length, ContentLength}} - end; - [<<"Connection:">>, <<"close">>] -> - parse_header(Socket, Timeout, - Header#header{connection = close}); - _ -> parse_header(Socket, Timeout, Header) - end; - {error, Reason} -> {error, Reason} +handle_payload(Socket, KeepAlive, Timeout, Options, Header) -> + case get_payload(Socket, Timeout, Options, Header#header.content_length) of + {ok, Payload} -> + ?DEBUG_LOG({encoded_response, Payload}), + case xmlrpc_decode:payload(Payload) of + {ok, {response, DecodedPayload}} when KeepAlive == false -> + ?DEBUG_LOG({decoded_response, DecodedPayload}), + comm_close(Options, Socket), + case has_header_option(Options) of + true -> + {ok, {response, DecodedPayload, Header}}; + _ -> + {ok, {response, DecodedPayload}} + end; + {ok, {response, DecodedPayload}} when KeepAlive == true, + Header#header.connection == close -> + ?DEBUG_LOG({decoded_response, DecodedPayload}), + comm_close(Options, Socket), + case has_header_option(Options) of + true -> + {ok, Socket, {response, DecodedPayload, Header}}; + _ -> + {ok, Socket, {response, DecodedPayload}} + end; + {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. -handle_payload(Socket, KeepAlive, Timeout, Header) -> - case get_payload(Socket, Timeout, - Header#header.content_length) - of - {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). +get_payload(Socket, Timeout, SslOption, ContentLength) -> + M = fetch_comm_module(SslOption), + apply(fetch_sets_module(SslOption), setopts, [Socket, [{packet, raw}]]), + apply(M, recv, [Socket, ContentLength, Timeout]). %% Exported: start_link/{1,5,6} -start_link(Handler) -> - start_link(4567, 1000, 60000, Handler, undefined). +start_link(Handler) -> start_link(4567, 1000, 60000, Handler, undefined). -start_link(Port, MaxSessions, Timeout, Handler, - State) -> - start_link(all, Port, MaxSessions, Timeout, Handler, - State). +start_link(Port, MaxSessions, Timeout, Handler, State) -> + start_link(all, Port, MaxSessions, Timeout, Handler, State). -start_link(IP, Port, MaxSessions, Timeout, Handler, - State) -> - OptionList = [{active, false}, {reuseaddr, true}] ++ - ip(IP), - SessionHandler = {xmlrpc_http, handler, - [Timeout, Handler, State]}, - tcp_serv:start_link([Port, MaxSessions, OptionList, - SessionHandler]). +start_link(IP, Port, MaxSessions, Timeout, Handler, State) -> + OptionList = [{active, false}, {reuseaddr, true}] ++ ip(IP), + SessionHandler = {xmlrpc_http, handler, [Timeout, Handler, State]}, + tcp_serv:start_link([Port, MaxSessions, OptionList, SessionHandler]). ip(all) -> []; ip(IP) when is_tuple(IP) -> [{ip, IP}]. diff --git a/src/xmlrpc.hrl b/src/xmlrpc.hrl new file mode 100644 index 000000000..6f5af432c --- /dev/null +++ b/src/xmlrpc.hrl @@ -0,0 +1,41 @@ +%% Copyright (C) 2003 Joakim Grebenö . +%% 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 + }). + diff --git a/src/xmlrpc_decode.erl b/src/xmlrpc_decode.erl index 72c78cf4a..344d077aa 100644 --- a/src/xmlrpc_decode.erl +++ b/src/xmlrpc_decode.erl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,217 +25,200 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(xmlrpc_decode). - -author('jocke@gleipnir.com'). - -export([payload/1]). --include("log.hrl"). - -include_lib("xmerl/include/xmerl.hrl"). payload(Payload) -> - ?DEBUG_LOG({scanning_payload, Payload}), - case xmerl_scan:string(Payload) of - {error, Reason} -> - ?DEBUG_LOG({error_scanning, Payload, Reason}), - {error, Reason}; - {E, _} -> - ?DEBUG_LOG({decoding_element, E}), - 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 + case catch xmerl_scan:string(Payload, [{encoding, latin1}]) of + {'EXIT', Reason} -> {error, Reason}; + {E, _} -> + case catch decode_element(E) of + {'EXIT', Reason} -> {error, Reason}; + Result -> Result + end end. -decode_element(#xmlElement{name = methodCall} = - MethodCall) - when is_record(MethodCall, xmlElement) -> - {MethodName, Rest} = match_element([methodName], - MethodCall#xmlElement.content), - TextValue = - get_text_value(MethodName#xmlElement.content), +decode_element(#xmlElement{name = methodCall} = MethodCall) + when record(MethodCall, xmlElement) -> + {MethodName, Rest} = + match_element([methodName], MethodCall#xmlElement.content), + TextValue = get_text_value(MethodName#xmlElement.content), case match_element(normal, [params], Rest) of - {error, {missing_element, _}} -> - {ok, {call, jlib:binary_to_atom(TextValue), []}}; - {Params, _} -> - DecodedParams = - decode_params(Params#xmlElement.content), - {ok, - {call, jlib:binary_to_atom(TextValue), DecodedParams}} + {error, {missing_element, _}} -> + {ok, {call, list_to_atom(TextValue), []}}; + {Params, _} -> + DecodedParams = decode_params(Params#xmlElement.content), + {ok, {call, list_to_atom(TextValue), DecodedParams}} end; -decode_element(#xmlElement{name = methodResponse} = - MethodResponse) - when is_record(MethodResponse, xmlElement) -> - case match_element([fault, params], - MethodResponse#xmlElement.content) - of - {Fault, _} when Fault#xmlElement.name == fault -> - {Value, _} = match_element([value], - Fault#xmlElement.content), - case decode(Value#xmlElement.content) of - {struct, [{faultCode, Code}, {faultString, String}]} - when is_integer(Code) -> - case xmlrpc_util:is_string(String) of - yes -> {ok, {response, {fault, Code, String}}}; - no -> {error, {bad_string, String}} - end; - _ -> {error, {bad_element, MethodResponse}} - end; - {Params, _} -> - case decode_params(Params#xmlElement.content) of - [DecodedParam] -> {ok, {response, [DecodedParam]}}; - DecodedParams -> - {error, {to_many_params, DecodedParams}} - end +decode_element(#xmlElement{name = methodResponse} = MethodResponse) + when record(MethodResponse, xmlElement) -> + case match_element([fault, params], MethodResponse#xmlElement.content) of + {Fault, _} when Fault#xmlElement.name == fault -> + {Value, _} = match_element([value], Fault#xmlElement.content), + case decode(Value#xmlElement.content) of + {struct, [{faultCode, Code}, + {faultString, String}]} when integer(Code) -> + case xmlrpc_util:is_string(String) of + yes -> {ok, {response, {fault, Code, String}}}; + no -> {error, {bad_string, String}} + end; + {struct, [{faultString, String}, + {faultCode, Code}]} when integer(Code) -> + %% This case has been found in java xmlrpc + case xmlrpc_util:is_string(String) of + yes -> {ok, {response, {fault, Code, String}}}; + no -> {error, {bad_string, String}} + end; + _ -> + {error, {bad_element, MethodResponse}} + end; + {Params, _} -> + case decode_params(Params#xmlElement.content) of + [DecodedParam] -> {ok, {response, [DecodedParam]}}; + DecodedParams -> {error, {to_many_params, DecodedParams}} + end end; decode_element(E) -> {error, {bad_element, E}}. -match_element(NameList, Content) -> - match_element(throw, NameList, Content). +match_element(NameList, Content) -> match_element(throw, NameList, Content). match_element(Type, NameList, []) -> return(Type, {error, {missing_element, NameList}}); -match_element(Type, NameList, [E | Rest]) - when is_record(E, xmlElement) -> +match_element(Type, NameList, [E|Rest]) when record(E, xmlElement) -> case lists:member(E#xmlElement.name, NameList) of - true -> {E, Rest}; - false -> - return(Type, - {error, {unexpected_element, E#xmlElement.name}}) + true -> {E, Rest}; + false -> return(Type, {error, {unexpected_element, E#xmlElement.name}}) end; -match_element(Type, NameList, [T | Rest]) - when is_record(T, xmlText) -> +match_element(Type, NameList, [T|Rest]) when record(T, xmlText) -> case only_whitespace(T#xmlText.value) of - yes -> match_element(Type, NameList, Rest); - no -> - return(Type, - {error, {unexpected_text, T#xmlText.value, NameList}}) + yes -> match_element(Type, NameList, Rest); + no -> + return(Type, {error, {unexpected_text, T#xmlText.value, NameList}}) end. return(throw, Result) -> throw(Result); return(normal, Result) -> Result. -only_whitespace(<<>>) -> yes; -only_whitespace(<<$\s, Rest/binary>>) -> - only_whitespace(Rest); -only_whitespace(<<$\n, Rest/binary>>) -> - only_whitespace(Rest); -only_whitespace(<<$\t, Rest/binary>>) -> - only_whitespace(Rest); +only_whitespace([]) -> yes; +only_whitespace([$ |Rest]) -> only_whitespace(Rest); +only_whitespace([$\n|Rest]) -> only_whitespace(Rest); +only_whitespace([$\t|Rest]) -> only_whitespace(Rest); only_whitespace(_) -> no. -get_text_value([]) -> <<>>; -get_text_value([T | Rest]) when is_record(T, xmlText) -> - <<(list_to_binary(T#xmlText.value))/binary, (get_text_value(Rest))/binary>>; +get_text_value([]) -> []; +get_text_value([T|Rest]) when record(T, xmlText) -> + T#xmlText.value++get_text_value(Rest); get_text_value(_) -> throw({error, missing_text}). decode_params([]) -> []; decode_params(Content) -> case match_element(normal, [param], Content) of - {error, {missing_element, _}} -> []; - {Param, Rest} -> - {Value, _} = match_element([value], - Param#xmlElement.content), - [decode(Value#xmlElement.content) | decode_params(Rest)] + {error, {missing_element, _}} -> []; + {Param, Rest} -> + {Value, _} = match_element([value], Param#xmlElement.content), + [decode(Value#xmlElement.content)|decode_params(Rest)] end. -decode(Content) when is_list(Content) -> +decode(Content) when list(Content) -> case get_value(Content) of - {text_value, TextValue} -> TextValue; - E -> decode(E) + {text_value, TextValue} -> TextValue; + E -> decode(E) end; -decode(String) when is_record(String, xmlText) -> - String#xmlText.value; +decode(String) when record(String, xmlText) -> String#xmlText.value; decode(Struct) when Struct#xmlElement.name == struct -> {struct, decode_members(Struct#xmlElement.content)}; decode(Array) when Array#xmlElement.name == array -> - {Data, _} = match_element([data], - Array#xmlElement.content), + {Data, _} = match_element([data], Array#xmlElement.content), {array, decode_values(Data#xmlElement.content)}; -decode(Int) - when Int#xmlElement.name == int; - Int#xmlElement.name == i4 -> +decode(Int) when Int#xmlElement.name == int; Int#xmlElement.name == i4 -> TextValue = get_text_value(Int#xmlElement.content), make_integer(TextValue); -decode(Boolean) - when Boolean#xmlElement.name == boolean -> +decode(Boolean) when Boolean#xmlElement.name == boolean -> case get_text_value(Boolean#xmlElement.content) of - <<"1">> -> true; - <<"0">> -> false; - TextValue -> - throw({error, {invalid_boolean, TextValue}}) + "1" -> true; + "0" -> false; + TextValue -> throw({error, {invalid_boolean, TextValue}}) end; decode(String) when String#xmlElement.name == string -> get_text_value(String#xmlElement.content); decode(Double) when Double#xmlElement.name == double -> TextValue = get_text_value(Double#xmlElement.content), make_double(TextValue); -decode(Date) - when Date#xmlElement.name == 'dateTime.iso8601' -> +decode(Date) when Date#xmlElement.name == 'dateTime.iso8601' -> 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 -> 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}}). get_value(Content) -> case any_element(Content) of - false -> {text_value, get_text_value(Content)}; - true -> get_element(Content) + false -> {text_value, get_text_value(Content)}; + true -> get_element(Content) end. any_element([]) -> false; -any_element([E | _]) when is_record(E, xmlElement) -> true; -any_element([_ | Rest]) -> any_element(Rest). +any_element([E|_]) when record(E, xmlElement) -> true; +any_element([_|Rest]) -> any_element(Rest). get_element([]) -> throw({error, missing_element}); -get_element([E | _]) when is_record(E, xmlElement) -> E; -get_element([T | Rest]) when is_record(T, xmlText) -> +get_element([E|_]) when record(E, xmlElement) -> E; +get_element([T|Rest]) when record(T, xmlText) -> case only_whitespace(T#xmlText.value) of - yes -> get_element(Rest); - no -> throw({error, {unexpected_text, T#xmlText.value}}) + yes -> get_element(Rest); + no -> throw({error, {unexpected_text, T#xmlText.value}}) end. decode_members(Content) -> case match_element(normal, [member], Content) of - {error, {missing_element, _}} -> []; - {Member, Rest} -> - {Name, Rest2} = match_element([name], - Member#xmlElement.content), - TextValue = get_text_value(Name#xmlElement.content), - {Value, _} = match_element([value], Rest2), - [{jlib:binary_to_atom(TextValue), - decode(Value#xmlElement.content)} - | decode_members(Rest)] + {error, {missing_element, _}} -> []; + {Member, Rest} -> + {Name, Rest2} = match_element([name], Member#xmlElement.content), + TextValue = get_text_value(Name#xmlElement.content), + {Value, _} = match_element([value], Rest2), + [{list_to_atom(TextValue), + decode(Value#xmlElement.content)}|decode_members(Rest)] end. decode_values([]) -> []; decode_values(Content) -> case match_element(normal, [value], Content) of - {error, {missing_element, _}} -> []; - {Value, Rest} -> - [decode(Value#xmlElement.content) | decode_values(Rest)] + {error, {missing_element, _}} -> []; + {Value, Rest} -> + [decode(Value#xmlElement.content)|decode_values(Rest)] end. make_integer(Integer) -> - case catch jlib:binary_to_integer(Integer) of - {'EXIT', _Reason} -> - throw({error, {not_integer, Integer}}); - Value -> Value + case catch list_to_integer(Integer) of + {'EXIT', _Reason} -> throw({error, {not_integer, Integer}}); + Value -> Value end. make_double(Double) -> - case catch list_to_float(binary_to_list(Double)) of - {'EXIT', _} -> throw({error, {not_double, Double}}); - Value -> Value + case catch list_to_float(Double) of + {'EXIT', _} -> + case catch list_to_integer(Double) of + {'EXIT', _} -> + throw({error, {not_double, Double}}); + Value -> float(Value) + end; + Value -> Value end. -ensure_iso8601_date(Date) -> - xmlrpc_util:is_iso8601_date(Date). - -ensure_base64(Base64) -> - xmlrpc_util:is_base64(Base64). +% FIXME +%ensure_iso8601_date(Date) -> +% case xmlrpc_util:is_iso8601_date(Date) of +% no -> throw({error, {not_iso8601_date, Date}}); +% yes -> Date +% end. +% +%ensure_base64(Base64) -> +% case xmlrpc_util:is_base64(Base64) of +% no -> throw({error, {not_base64, Base64}}); +% yes -> Base64 +% end. diff --git a/src/xmlrpc_encode.erl b/src/xmlrpc_encode.erl index a903360dc..f7d0ff19e 100644 --- a/src/xmlrpc_encode.erl +++ b/src/xmlrpc_encode.erl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,103 +25,121 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(xmlrpc_encode). - -author('jocke@gleipnir.com'). - -export([payload/1]). %% Exported: payload/1 --type xmlrpc() :: number() | boolean() | binary() | - {base64, binary()} | {date, binary()} | - {array, [xmlrpc()]} | {struct, [{atom(), xmlrpc()}]}. +payload({call, Name, Params}) when atom(Name), list(Params) -> + case encode_params(Params) of + {error, Reason} -> {error, Reason}; + EncodedParams -> + EncodedPayload = + ["", + atom_to_list(Name), "", EncodedParams, + ""], + {ok, EncodedPayload} + end; +payload({response, {fault, Code, String}}) when integer(Code) -> + case xmlrpc_util:is_string(String) of + yes -> + EncodedPayload = + ["" + "faultCode", + integer_to_list(Code), "" + "faultString", escape_string(String), + "", + ""], + {ok, EncodedPayload}; + no -> {error, {bad_string, String}} + end; +payload({response, []} = Payload) -> + {ok, [""]}; +payload({response, [Param]} = Payload) -> + case encode_params([Param]) of + {error, Reason} -> {error, Reason}; + EncodedParam -> + {ok, ["", EncodedParam, + ""]} + end; +payload(Payload) -> {error, {bad_payload, Payload}}. --spec payload({call, atom(), [xmlrpc()]} | - {response, {fault, integer(), binary()} | [xmlrpc()]}) -> - binary(). +encode_params(Params) -> encode_params(Params, []). -payload({call, Name, Params}) -> - <<"", - (jlib:atom_to_binary(Name))/binary, - "", - (encode_params(Params))/binary, - "">>; -payload({response, {fault, Code, String}}) -> - <<"faultCode", - (jlib:integer_to_binary(Code))/binary, - "faultStr" - "ing", - (escape_string(String))/binary, - "">>; -payload({response, []}) -> - <<"">>; -payload({response, [Param]}) -> - <<"", - (encode_params([Param]))/binary, - "">>. - -encode_params(Params) -> encode_params(Params, <<>>). - -encode_params([], <<>>) -> <<>>; -encode_params([], Acc) -> - <<"", Acc/binary, "">>; -encode_params([Param | Rest], Acc) -> - EncodedParam = encode(Param), - NewAcc = <", - EncodedParam/binary, "">>, - encode_params(Rest, NewAcc). +encode_params([], []) -> []; +encode_params([], Acc) -> ["", Acc, ""]; +encode_params([Param|Rest], Acc) -> + case encode(Param) of + {error, Reason} -> {error, Reason}; + EncodedParam -> + NewAcc = Acc++["", EncodedParam, ""], + encode_params(Rest, NewAcc) + end. encode({struct, Struct}) -> - Members = encode_members(Struct), - <<"", Members/binary, "">>; -encode({array, Array}) -> - Values = encode_values(Array), - <<"", Values/binary, "">>; -encode(Integer) when is_integer(Integer) -> - <<"", (jlib:integer_to_binary(Integer))/binary, "">>; -encode(true) -> <<"1">>; % duh! -encode(false) -> <<"0">>; % duh! -encode(Double) when is_float(Double) -> - list_to_binary( - [<<"">>, io_lib:format("~p", [Double]), - <<"">>]); + case encode_members(Struct) of + {error, Reason} -> {error, Reason}; + Members -> ["", Members, ""] + end; +encode({array, Array}) when list(Array) -> + case encode_values(Array)of + {error, Reason} -> {error, Reason}; + Values -> ["", Values, ""] + end; +encode(Integer) when integer(Integer) -> + ["", integer_to_list(Integer), ""]; +encode(true) -> "1"; % duh! +encode(false) -> "0"; % duh! +encode(Double) when float(Double) -> + ["", io_lib:format("~p", [Double]), ""]; encode({date, Date}) -> - <<"", Date/binary, "">>; + case xmlrpc_util:is_iso8601_date(Date) of + yes -> ["", Date, ""]; + no -> {error, {bad_date, Date}} + end; encode({base64, Base64}) -> - <<"", Base64/binary, "">>; + case xmlrpc_util:is_base64(Base64) of + yes -> ["", Base64, ""]; + no -> {error, {bad_base64, Base64}} + end; encode(Value) -> - escape_string(Value). + case xmlrpc_util:is_string(Value) of + yes -> ["", escape_string(Value), ""]; + no -> {error, {bad_value, Value}} + end. -escape_string(<<>>) -> <<>>; -escape_string(<<$<, Rest/binary>>) -> - <<"<", (escape_string(Rest))/binary>>; -escape_string(<<$>, Rest/binary>>) -> - <<">", (escape_string(Rest))/binary>>; -escape_string(<<$&, Rest/binary>>) -> - <<"&", (escape_string(Rest))/binary>>; -escape_string(<>) -> <>. +escape_string([]) -> []; +escape_string([$<|Rest]) -> ["<", escape_string(Rest)]; +escape_string([$>|Rest]) -> [">", escape_string(Rest)]; +escape_string([$&|Rest]) -> ["&", escape_string(Rest)]; +escape_string([C|Rest]) -> [C|escape_string(Rest)]. -encode_members(Struct) -> encode_members(Struct, <<>>). +encode_members(Struct) -> encode_members(Struct, []). encode_members([], Acc) -> Acc; -encode_members([{Name, Value} | Rest], Acc) -> - NewAcc = <", - (jlib:atom_to_binary(Name))/binary, - "", - (encode(Value))/binary, - "">>, - encode_members(Rest, NewAcc). +encode_members([{Name, Value}|Rest], Acc) when atom(Name) -> + case encode(Value) of + {error, Reason} -> {error, Reason}; + EncodedValue -> + NewAcc = + Acc++["", atom_to_list(Name), "", + EncodedValue, ""], + 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([Value | Rest], Acc) -> - NewAcc = <", - (encode(Value))/binary, - "">>, - encode_values(Rest, NewAcc). +encode_values([Value|Rest], Acc) -> + case encode(Value) of + {error, Reason} -> {error, Reason}; + EncodedValue -> + NewAcc = Acc++["", EncodedValue, ""], + encode_values(Rest, NewAcc) + end; +encode_values([{Name, Value}|Rest], Acc) -> {error, {invalid_name, Name}}; +encode_values(UnknownMember, Acc) -> + {error, {unknown_member, UnknownMember}}. diff --git a/src/xmlrpc_http.erl b/src/xmlrpc_http.erl index d3933e08f..0f3aedd23 100644 --- a/src/xmlrpc_http.erl +++ b/src/xmlrpc_http.erl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,192 +25,206 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(xmlrpc_http). - -author('jocke@gleipnir.com'). - -export([handler/4]). -include("log.hrl"). --record(header, - {content_length :: non_neg_integer(), - content_type :: binary(), - user_agent :: binary(), - connection :: close}). +-include("xmlrpc.hrl"). -%% Exported: handler/3 +%% Exported: handler/4 handler(Socket, Timeout, Handler, State) -> case parse_request(Socket, Timeout) of - {ok, Header} -> - ?DEBUG_LOG({header, Header}), - handle_payload(Socket, Timeout, Handler, State, Header); - {status, StatusCode} -> - send(Socket, StatusCode), - handler(Socket, Timeout, Handler, State); - {error, Reason} -> {error, Reason} + {ok, Header} -> + ?DEBUG_LOG({header, Header}), + handle_payload(Socket, Timeout, Handler, State, Header); + {status, StatusCode} -> + send(Socket, StatusCode), + handler(Socket, Timeout, Handler, State); + {error, Reason} -> {error, Reason} end. parse_request(Socket, Timeout) -> inet:setopts(Socket, [{packet, line}]), case gen_tcp:recv(Socket, 0, Timeout) of - {ok, RequestLine} -> - case str:tokens(RequestLine, <<" \r\n">>) of - [<<"POST">>, _, <<"HTTP/1.0">>] -> - ?DEBUG_LOG({http_version, <<"1.0">>}), - parse_header(Socket, Timeout, - #header{connection = close}); - [<<"POST">>, _, <<"HTTP/1.1">>] -> - ?DEBUG_LOG({http_version, <<"1.1">>}), - parse_header(Socket, Timeout); - [_Method, _, <<"HTTP/1.1">>] -> {status, 501}; - [<<"POST">>, _, _HTTPVersion] -> {status, 505}; - _ -> {status, 400} - end; - {error, Reason} -> {error, Reason} + {ok, RequestLine} -> + case string:tokens(RequestLine, " \r\n") of + ["POST", _, "HTTP/1.0"] -> + ?DEBUG_LOG({http_version, "1.0"}), + parse_header(Socket, Timeout, #header{connection = close}); + ["POST", _, "HTTP/1.1"] -> + ?DEBUG_LOG({http_version, "1.1"}), + parse_header(Socket, Timeout); + [_Method, _, "HTTP/1.1"] -> {status, 501}; + ["POST", _, _HTTPVersion] -> {status, 505}; + _ -> {status, 400} + end; + {error, Reason} -> {error, Reason} end. -parse_header(Socket, Timeout) -> - parse_header(Socket, Timeout, #header{}). +parse_header(Socket, Timeout) -> parse_header(Socket, Timeout, #header{}). parse_header(Socket, Timeout, Header) -> case gen_tcp:recv(Socket, 0, Timeout) of - {ok, <<"\r\n">>} - when Header#header.content_length == undefined -> - {status, 411}; - {ok, <<"\r\n">>} - when Header#header.content_type == undefined -> - {status, 400}; - {ok, <<"\r\n">>} - when Header#header.user_agent == undefined -> - {status, 400}; - {ok, <<"\r\n">>} -> {ok, Header}; - {ok, HeaderField} -> - case split_header_field(HeaderField) of - {<<"Content-", _, "ength:">>, ContentLength} -> - case catch jlib:binary_to_integer(ContentLength) of - N when is_integer(N), N>=0 -> - parse_header(Socket, Timeout, - Header#header{content_length = N}); - _ -> {status, 400} - end; - {<<"Content-Type:">>, <<"text/xml">>} -> - parse_header(Socket, Timeout, - Header#header{content_type = <<"text/xml">>}); - {<<"Content-Type:">>, <<"text/xml; charset=utf-8">>} -> - parse_header(Socket, Timeout, - Header#header{content_type = - <<"text/xml; charset=utf-8">>}); - {<<"Content-Type:">>, _ContentType} -> {status, 415}; - {<<"User-Agent:">>, UserAgent} -> - parse_header(Socket, Timeout, - Header#header{user_agent = UserAgent}); - {<<"Connection:">>, <<"close">>} -> - parse_header(Socket, Timeout, - Header#header{connection = close}); - {<<"Connection:">>, <<_, "eep-", _, "live">>} -> - parse_header(Socket, Timeout, - Header#header{connection = undefined}); - _ -> - ?DEBUG_LOG({skipped_header, HeaderField}), - parse_header(Socket, Timeout, Header) - end; - {error, Reason} -> {error, Reason} + {ok, "\r\n"} when Header#header.content_length == undefined -> + {status, 411}; + {ok, "\r\n"} when Header#header.content_type == undefined -> + {status, 400}; + {ok, "\r\n"} when Header#header.user_agent == undefined -> + {status, 400}; + {ok, "\r\n"} -> {ok, Header}; + {ok, HeaderField} -> + case split_header_field(HeaderField) of + {[$C,$o,$n,$t,$e,$n,$t,$-,_,$e,$n,$g,$t,$h,$:], + ContentLength} -> + case catch list_to_integer(ContentLength) of + N -> + parse_header(Socket, Timeout, + Header#header{content_length = N}); + _ -> {status, 400} + end; + {"Content-Type:", "text/xml"} -> + parse_header(Socket, Timeout, + Header#header{content_type = "text/xml"}); + {"Content-Type:", "text/xml; charset=utf-8"} -> + parse_header(Socket, Timeout, + Header#header{content_type = "text/xml; charset=utf-8"}); + {"Content-Type:", _ContentType} -> {status, 415}; + {"User-Agent:", UserAgent} -> + parse_header(Socket, Timeout, + Header#header{user_agent = UserAgent}); + {"Connection:", "close"} -> + parse_header(Socket, Timeout, + Header#header{connection = close}); + {"Connection:", [_,$e,$e,$p,$-,_,$l,$i,$v,$e]} -> + parse_header(Socket, Timeout, + Header#header{connection = undefined}); + {"Authorization:", Authorization} -> + parse_header(Socket, Timeout, + Header#header{authorization = Authorization}); + {"Cookie:", Cookie} -> + Cookies = [ Cookie | Header#header.cookies ], + parse_header(Socket, Timeout, + Header#header{cookies = Cookies}); + _ -> + ?DEBUG_LOG({skipped_header, HeaderField}), + parse_header(Socket, Timeout, Header) + end; + {error, Reason} -> {error, Reason} end. -split_header_field(HeaderField) -> - split_header_field(binary_to_list(HeaderField), []). +split_header_field(HeaderField) -> split_header_field(HeaderField, []). -split_header_field([], Name) -> {list_to_binary(Name), <<"">>}; -split_header_field([$\s | Rest], Name) -> - {list_to_binary(lists:reverse(Name)), - list_to_binary(Rest -- "\r\n")}; -split_header_field([C | Rest], Name) -> - split_header_field(Rest, [C | Name]). +split_header_field([], Name) -> {Name, ""}; +split_header_field([$ |Rest], Name) -> {lists:reverse(Name), Rest -- "\r\n"}; +split_header_field([C|Rest], Name) -> split_header_field(Rest, [C|Name]). handle_payload(Socket, Timeout, Handler, State, #header{connection = Connection} = Header) -> - case get_payload(Socket, Timeout, - Header#header.content_length) - of - {ok, Payload} -> - ?DEBUG_LOG({encoded_call, Payload}), - case xmlrpc_decode:payload(Payload) of - {ok, DecodedPayload} -> - ?DEBUG_LOG({decoded_call, DecodedPayload}), - eval_payload(Socket, Timeout, Handler, State, - Connection, DecodedPayload); - {error, Reason} when Connection == close -> - ?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}), - send(Socket, 400); - {error, Reason} -> - ?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}), - send(Socket, 400), - handler(Socket, Timeout, Handler, State) - end; - {error, Reason} -> {error, Reason} + case get_payload(Socket, Timeout, Header#header.content_length) of + {ok, Payload} -> + ?DEBUG_LOG({encoded_call, Payload}), + case xmlrpc_decode:payload(Payload) of + {ok, DecodedPayload} -> + ?DEBUG_LOG({decoded_call, DecodedPayload}), + eval_payload(Socket, Timeout, Handler, State, Connection, + DecodedPayload, Header); + {error, Reason} when Connection == close -> + ?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}), + send(Socket, 400); + {error, Reason} -> + ?ERROR_LOG({xmlrpc_decode, payload, Payload, Reason}), + send(Socket, 400), + handler(Socket, Timeout, Handler, State) + end; + {error, Reason} -> {error, Reason} end. get_payload(Socket, Timeout, ContentLength) -> - inet:setopts(Socket, [binary, {packet, raw}]), + inet:setopts(Socket, [{packet, raw}]), gen_tcp:recv(Socket, ContentLength, Timeout). -eval_payload(Socket, Timeout, {M, F} = Handler, State, - Connection, Payload) -> - case catch M:F(State, Payload) of - {'EXIT', Reason} when Connection == close -> - ?ERROR_LOG({M, F, {'EXIT', Reason}}), - send(Socket, 500, <<"Connection: close\r\n">>); - {'EXIT', Reason} -> - ?ERROR_LOG({M, F, {'EXIT', Reason}}), - send(Socket, 500), - handler(Socket, Timeout, Handler, State); - {error, Reason} when Connection == close -> - ?ERROR_LOG({M, F, Reason}), - send(Socket, 500, <<"Connection: close\r\n">>); - {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); - {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) +%% Check whether module has defined new function +%% M:F(State, Payload, Header) +has_newcall(M, F) -> + erlang:function_exported(M, F, 3). + +%% Handle module call +do_call({M, F} = _Handler, State, Payload, Header) -> + case has_newcall(M, F) of + true -> + M:F(State, Payload, Header); + false -> + M:F(State, Payload) + end. + +eval_payload(Socket, Timeout, {M, F} = Handler, State, Connection, Payload, Header) -> + case catch do_call(Handler, State, Payload, Header) of + {'EXIT', Reason} when Connection == close -> + ?ERROR_LOG({M, F, {'EXIT', Reason}}), + send(Socket, 500, "Connection: close\r\n"); + {'EXIT', Reason} -> + ?ERROR_LOG({M, F, {'EXIT', Reason}}), + send(Socket, 500), + handler(Socket, Timeout, Handler, State); + {error, Reason} when Connection == close -> + ?ERROR_LOG({M, F, Reason}), + send(Socket, 500, "Connection: close\r\n"); + {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. encode_send(Socket, StatusCode, ExtraHeader, Payload) -> ?DEBUG_LOG({decoded_response, Payload}), - EncodedPayload = xmlrpc_encode:payload(Payload), - ?DEBUG_LOG({encoded_response, EncodedPayload}), - send(Socket, StatusCode, ExtraHeader, EncodedPayload). + case xmlrpc_encode:payload(Payload) of + {ok, 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, Payload) -> - Response = [<<"HTTP/1.1 ">>, - jlib:integer_to_binary(StatusCode), <<" ">>, - reason_phrase(StatusCode), <<"\r\n">>, - <<"Content-Length: ">>, - jlib:integer_to_binary(byte_size(Payload)), - <<"\r\n">>, <<"Server: Erlang/1.13\r\n">>, - <<"Content-Type: text/xml\r\n">>, ExtraHeader, - <<"\r\n">>, Payload], + Response = + ["HTTP/1.1 ", integer_to_list(StatusCode), " ", + reason_phrase(StatusCode), "\r\n", + "Content-Length: ", integer_to_list(lists:flatlength(Payload)), + "\r\n", + "Server: Erlang/1.13\r\n", + "Content-Type: text/xml\r\n", + ExtraHeader, "\r\n", + Payload], gen_tcp:send(Socket, Response). -reason_phrase(200) -> <<"OK">>; -reason_phrase(400) -> <<"Bad Request">>; -reason_phrase(411) -> <<"Length required">>; -reason_phrase(415) -> <<"Unsupported Media Type">>; -reason_phrase(500) -> <<"Internal Server Error">>; -reason_phrase(501) -> <<"Not Implemented">>; -reason_phrase(505) -> <<"HTTP Version not supported">>. +reason_phrase(200) -> "OK"; +reason_phrase(400) -> "Bad Request"; +reason_phrase(411) -> "Length required"; +reason_phrase(415) -> "Unsupported Media Type"; +reason_phrase(500) -> "Internal Server Error"; +reason_phrase(501) -> "Not Implemented"; +reason_phrase(505) -> "HTTP Version not supported". diff --git a/src/xmlrpc_util.erl b/src/xmlrpc_util.erl index 576104b42..d46c5c07b 100644 --- a/src/xmlrpc_util.erl +++ b/src/xmlrpc_util.erl @@ -3,10 +3,10 @@ %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions -%% are met: +%% are met: %% %% 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 %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided @@ -25,18 +25,13 @@ %% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(xmlrpc_util). - -author('jocke@gleipnir.com'). - -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. --spec is_iso8601_date(binary()) -> yes. +is_iso8601_date(_) -> yes. % FIXME -is_iso8601_date(_) -> yes. - --spec is_base64(binary()) -> yes. - -is_base64(_) -> yes. +is_base64(_) -> yes. % FIXME