Copy xmlrpc-1.13 source code

2024-10-05 14:51:05 +02:00 · 2010-10-19 15:58:42 +02:00 · 2010-10-19 15:58:42 +02:00 · 440eef74e9
commit 440eef74e9
parent c849552177
7 changed files with 991 additions and 0 deletions
--- a/src/log.hrl
+++ b/src/log.hrl
@ -0,0 +1,38 @@
+%% 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.
+
+-define(INFO_LOG(Reason),
+	error_logger:info_report({?MODULE, ?LINE, Reason})).
+
+-define(ERROR_LOG(Reason),
+	error_logger:error_report({?MODULE, ?LINE, Reason})).
+
+-ifdef(DEBUG).
+-define(DEBUG_LOG(Reason),
+	error_logger:info_report({debug, ?MODULE, ?LINE, Reason})).
+-else.
+-define(DEBUG_LOG(Reason), ok).
+-endif.
--- a/src/tcp_serv.erl
+++ b/src/tcp_serv.erl
@ -0,0 +1,156 @@
+%% 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.
+
+-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, {
+	  %% 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]),
+    receive
+	{Pid, started} -> {ok, Pid};
+	{Pid, Reason} -> {error, Reason}
+    after Timeout -> {error, timeout}
+    end.
+
+%% Exported: stop/{1,2}
+
+stop(Pid) -> stop(Pid, 15000).
+
+stop(Pid, Timeout) ->
+    Pid ! {self(), stop}, 
+    receive
+	{Pid, Reply} -> Reply
+    after
+	Timeout -> {error, timeout}
+    end.
+
+%% Exported: init/2
+
+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}}
+    end.
+
+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)
+    end.
+
+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
+    end.
+
+%% Exported: system_continue/3
+
+system_continue(Parent, DebugInfo, State) ->
+    loop(State#state{parent = Parent, debug_info = DebugInfo}).
+
+%% Exported: system_terminate/3
+
+system_terminate(Reason, Parent, DebugInfo, State) ->
+    cleanup(State),
+    exit(Reason).
--- a/src/xmlrpc.erl
+++ b/src/xmlrpc.erl
@ -0,0 +1,187 @@
+%% 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.
+
+-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]).
+
+-include("log.hrl").
+
+-record(header, {
+	  %% int()
+	  content_length,
+	  %% close | undefined
+	  connection
+	 }).
+
+%% 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, [{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, false, 60000).
+
+call(Socket, URI, Payload, KeepAlive, Timeout) ->
+    ?DEBUG_LOG({decoded_call, Payload}),
+    case xmlrpc_encode:payload(Payload) of
+	{ok, EncodedPayload} ->
+	    ?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}
+	    end;
+	{error, Reason} when KeepAlive == false ->
+	    gen_tcp:close(Socket),
+	    {error, Reason};
+	{error, Reason} -> {error, Socket, 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: ", 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],
+    gen_tcp:send(Socket, Request).
+
+parse_response(Socket, Timeout) ->
+    inet:setopts(Socket, [{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}
+    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 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,
+					 Header#header{content_length =
+						       Value})
+		    end;
+		["Connection:", "close"] ->
+		    parse_header(Socket, Timeout,
+				 Header#header{connection = close});
+		_ ->
+		    parse_header(Socket, Timeout, Header)
+	    end;
+	{error, Reason} -> {error, 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, [{packet, raw}]),
+    gen_tcp:recv(Socket, ContentLength, Timeout).
+
+%% Exported: start_link/{1,5,6}
+
+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(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 tuple(IP) -> [{ip, IP}].
+
+%% Exported: stop/1
+
+stop(Pid) -> tcp_serv:stop(Pid).
--- a/src/xmlrpc_decode.erl
+++ b/src/xmlrpc_decode.erl
@ -0,0 +1,218 @@
+%% 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.
+
+-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
+    end.
+
+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, 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 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;
+		_ ->
+		    {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(Type, NameList, []) ->
+    return(Type, {error, {missing_element, NameList}});
+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}})
+    end;
+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}})
+    end.
+
+return(throw, Result) -> throw(Result);
+return(normal, Result) -> Result.
+
+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 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)]
+    end.
+
+decode(Content) when list(Content) ->
+    case get_value(Content) of
+	{text_value, TextValue} -> TextValue;
+	E -> decode(E)
+    end;
+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),
+    {array, decode_values(Data#xmlElement.content)};
+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 ->
+    case get_text_value(Boolean#xmlElement.content) of
+	"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' ->
+    TextValue = get_text_value(Date#xmlElement.content),
+    {date, ensure_iso8601_date(TextValue)};
+decode(Base64) when Base64#xmlElement.name == base64 ->
+    TextValue = get_text_value(Base64#xmlElement.content),
+    {base64, ensure_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)
+    end.
+
+any_element([]) -> false;
+any_element([E|_]) when record(E, xmlElement) -> true;
+any_element([_|Rest]) -> any_element(Rest).
+
+get_element([]) -> throw({error, missing_element});
+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}})
+    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),
+	    [{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)]
+    end.
+
+make_integer(Integer) ->
+    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(Double) of
+	{'EXIT', _} -> throw({error, {not_double, Double}});
+	Value -> Value
+    end.
+
+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.
--- a/src/xmlrpc_encode.erl
+++ b/src/xmlrpc_encode.erl
@ -0,0 +1,145 @@
+%% 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.
+
+-module(xmlrpc_encode).
+-author('jocke@gleipnir.com').
+-export([payload/1]).
+
+%% Exported: payload/1
+
+payload({call, Name, Params}) when atom(Name), list(Params) ->
+    case encode_params(Params) of
+	{error, Reason} -> {error, Reason};
+	EncodedParams ->
+	    EncodedPayload =
+		["<?xml version=\"1.0\"?><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\"?><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\"?><methodResponse>", EncodedParam,
+		  "</methodResponse>"]}
+    end;
+payload(Payload) -> {error, {bad_payload, Payload}}.
+
+encode_params(Params) -> encode_params(Params, []).
+
+encode_params([], []) -> [];
+encode_params([], Acc) -> ["<params>", Acc, "</params>"];
+encode_params([Param|Rest], Acc) ->
+    case encode(Param) of
+	{error, Reason} -> {error, Reason};
+	EncodedParam ->
+	    NewAcc = Acc++["<param><value>", EncodedParam, "</value></param>"],
+	    encode_params(Rest, NewAcc)
+    end.
+
+encode({struct, Struct}) ->
+    case encode_members(Struct) of
+	{error, Reason} -> {error, Reason};
+	Members -> ["<struct>", Members, "</struct>"]
+    end;
+encode({array, Array}) when list(Array) ->
+    case encode_values(Array)of
+	{error, Reason} -> {error, Reason};
+	Values -> ["<array><data>", Values, "</data></array>"]
+    end;
+encode(Integer) when integer(Integer) ->
+    ["<int>", integer_to_list(Integer), "</int>"];
+encode(true) -> "<boolean>1</boolean>"; % duh!
+encode(false) -> "<boolean>0</boolean>"; % duh!
+encode(Double) when float(Double) ->
+    ["<double>", io_lib:format("~p", [Double]), "</double>"];
+encode({date, Date}) ->
+    case xmlrpc_util:is_iso8601_date(Date) of
+	yes -> ["<dateTime.iso8601>", Date, "</dateTime.iso8601>"];
+	no -> {error, {bad_date, Date}}
+    end;
+encode({base64, Base64}) ->
+    case xmlrpc_util:is_base64(Base64) of
+	yes -> ["<base64>", Base64, "</base64>"];
+	no -> {error, {bad_base64, Base64}}
+    end;
+encode(Value) ->
+    case xmlrpc_util:is_string(Value) of
+	yes -> escape_string(Value);
+	no -> {error, {bad_value, Value}}
+    end.
+
+escape_string([]) -> [];
+escape_string([$<|Rest]) -> ["&lt;", escape_string(Rest)];
+escape_string([$>|Rest]) -> ["&gt;", escape_string(Rest)];
+escape_string([$&|Rest]) -> ["&amp;", escape_string(Rest)];
+escape_string([C|Rest]) -> [C|escape_string(Rest)].
+
+encode_members(Struct) -> encode_members(Struct, []).
+
+encode_members([], Acc) -> Acc;
+encode_members([{Name, Value}|Rest], Acc) when atom(Name) ->
+    case encode(Value) of
+	{error, Reason} -> {error, Reason};
+	EncodedValue ->
+	    NewAcc =
+		Acc++["<member><name>", atom_to_list(Name), "</name><value>",
+		      EncodedValue, "</value></member>"],
+	    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([], Acc) -> Acc;
+encode_values([Value|Rest], Acc) ->
+    case encode(Value) of
+	{error, Reason} -> {error, Reason};
+	EncodedValue ->
+	    NewAcc = Acc++["<value>", EncodedValue, "</value>"],
+	    encode_values(Rest, NewAcc)
+    end;
+encode_values([{Name, Value}|Rest], Acc) -> {error, {invalid_name, Name}};
+encode_values(UnknownMember, Acc) ->
+    {error, {unknown_member, UnknownMember}}.
--- a/src/xmlrpc_http.erl
+++ b/src/xmlrpc_http.erl
@ -0,0 +1,210 @@
+%% 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.
+
+-module(xmlrpc_http).
+-author('jocke@gleipnir.com').
+-export([handler/4]).
+
+-include("log.hrl").
+
+-record(header, {
+	  %% int()
+	  content_length,
+	  %% string()
+	  content_type,
+	  %% string()
+	  user_agent,
+	  %% close | undefined
+	  connection
+	 }).
+
+%% Exported: handler/3
+
+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}
+    end.
+
+parse_request(Socket, Timeout) ->
+    inet:setopts(Socket, [{packet, line}]),
+    case gen_tcp:recv(Socket, 0, Timeout) of
+	{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, 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
+		{[$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});
+		_ ->
+		    ?DEBUG_LOG({skipped_header, HeaderField}),
+		    parse_header(Socket, Timeout, Header)
+	    end;
+	{error, Reason} -> {error, Reason}
+    end.
+
+split_header_field(HeaderField) -> split_header_field(HeaderField, []).
+
+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}
+    end.
+
+get_payload(Socket, Timeout, ContentLength) ->
+    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)
+    end.
+
+encode_send(Socket, StatusCode, ExtraHeader, Payload) ->
+    ?DEBUG_LOG({decoded_response, Payload}),
+    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, ExtraHeader) ->
+    send(Socket, StatusCode, ExtraHeader, "").
+
+send(Socket, StatusCode, ExtraHeader, 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".
--- a/src/xmlrpc_util.erl
+++ b/src/xmlrpc_util.erl
@ -0,0 +1,37 @@
+%% 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.
+
+-module(xmlrpc_util).
+-author('jocke@gleipnir.com').
+-export([is_string/1, is_iso8601_date/1, is_base64/1]).
+
+is_string([C|Rest]) when C >= 0, C =< 255 -> is_string(Rest);
+is_string([]) -> yes;
+is_string(_) -> no.
+
+is_iso8601_date(_) -> yes. % FIXME
+
+is_base64(_) -> yes. % FIXME