Permalink
Browse files

[project @ Split JSONRPC code into transport-neutral, http, and inets…

…-specific modules.]
  • Loading branch information...
1 parent 39e817d commit 21d93e0fd30f5f9eacbfc255543f1abb7edab7ee @tonyg committed May 25, 2008
View
4 include/mod_jsonrpc.hrl → include/rfc4627_jsonrpc.hrl
@@ -1,4 +1,4 @@
-%% JSON-RPC for Erlang's inets httpd
+%% JSON-RPC for Erlang
%%---------------------------------------------------------------------------
%% Copyright (c) 2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
%% Copyright (c) 2007 LShift Ltd. <query@lshift.net>
@@ -24,7 +24,7 @@
%% SOFTWARE.
%%---------------------------------------------------------------------------
%%
-%% Records for JSON-RPC inets services using the mod_jsonrpc module.
+%% Records for JSON-RPC services using the rfc4627_jsonrpc module.
-record(service, {handler, name, id, version, summary, help, procs}).
-record(service_proc, {name, summary, help, idempotent = false, params, return}).
View
400 src/mod_jsonrpc.erl
@@ -1,400 +0,0 @@
-%% JSON-RPC for Erlang's inets httpd
-%%---------------------------------------------------------------------------
-%% Copyright (c) 2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
-%% Copyright (c) 2007 LShift Ltd. <query@lshift.net>
-%%
-%% Permission is hereby granted, free of charge, to any person
-%% obtaining a copy of this software and associated documentation
-%% files (the "Software"), to deal in the Software without
-%% restriction, including without limitation the rights to use, copy,
-%% modify, merge, publish, distribute, sublicense, and/or sell copies
-%% of the Software, and to permit persons to whom the Software is
-%% furnished to do so, subject to the following conditions:
-%%
-%% The above copyright notice and this permission notice shall be
-%% included in all copies or substantial portions of the Software.
-%%
-%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-%% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-%% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-%% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-%% SOFTWARE.
-%%---------------------------------------------------------------------------
-
--module(mod_jsonrpc).
--include("rfc4627.hrl").
--include("mod_jsonrpc.hrl").
--include_lib("inets/src/httpd.hrl").
-
--behaviour(gen_server).
-
--export([start/0, start_link/0]).
--export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
--export([do/1, load/2]).
--export([lookup_service/1, register_service/2, error_response/2, error_response/3, service/4, service/5, proc/2]).
--export([gen_object_name/0, service_address/2, system_describe/2]).
--export([jsonrpc_post/3, jsonrpc_post/4, invoke_service_method/6]).
-
-start() ->
- gen_server:start({local, mod_jsonrpc}, ?MODULE, [], []).
-
-start_link() ->
- gen_server:start_link({local, mod_jsonrpc}, ?MODULE, [], []).
-
-do(ModData = #mod{data = OldData}) ->
- case {httpd_util:key1search(OldData, status),
- httpd_util:key1search(OldData, response)} of
- {undefined, undefined} ->
- do_rpc(ModData);
- _ ->
- {proceed, OldData}
- end.
-
-load("JsonRpcAlias " ++ Alias, []) ->
- {ok, [], {json_rpc_alias, Alias}}.
-
-jsonrpc_post(ServiceRec, ModData, {obj, Fields}) ->
- jsonrpc_post(ServiceRec, ModData, {obj, Fields}, default).
-
-jsonrpc_post(ServiceRec, ModData, {obj, Fields}, Timeout) ->
- Id = httpd_util:key1search(Fields, "id"),
- Method = httpd_util:key1search(Fields, "method"),
- Args = httpd_util:key1search(Fields, "params"),
- {Headers, ResultField} =
- expand_jsonrpc_reply(
- invoke_service_method(ServiceRec, post, ModData, Method, Args, Timeout)),
- {Headers, build_jsonrpc_response(Id, ResultField)}.
-
-build_jsonrpc_response(Id, ResultField) ->
- {obj, [{version, <<"1.1">>},
- {id, Id},
- ResultField]}.
-
-lookup_service(Service) ->
- gen_server:call(mod_jsonrpc, {lookup_service, Service}).
-
-do_rpc(ModData = #mod{data = OldData}) ->
- case extract_object_method_and_params(ModData) of
- no_match ->
- {proceed, OldData};
- UriInfo = {_Object, _UriMethod, _UriParamStr} ->
- {PostOrGet, Id, Service, Method, Args, Timeout} = parse_jsonrpc(ModData, UriInfo),
- {Headers, ResultField} =
- expand_jsonrpc_reply(
- case lookup_service(Service) of
- not_found ->
- error_response(404, "Service not found", Service);
- ServiceRec ->
- invoke_service_method(
- ServiceRec, PostOrGet, ModData, Method, Args, Timeout)
- end),
- Result = build_jsonrpc_response(Id, ResultField),
- ResultEnc = lists:flatten(rfc4627:encode(Result)),
- {proceed, [{response, {response,
- [{code, 200},
- {content_length, integer_to_list(length(ResultEnc))},
- {content_type, "text/plain"}%rfc4627:mime_type()}
- | Headers],
- ResultEnc}} | OldData]}
- end.
-
-invoke_service_method(ServiceRec = #service{name = ServiceName},
- PostOrGet, ModData, Method, Args, Timeout) ->
- case Method of
- <<"system.describe">> ->
- {result, system_describe(service_address(ModData, ServiceName), ServiceRec)};
- <<"system.", _Rest/binary>> ->
- error_response(403, "System methods forbidden", Method);
- _ ->
- case lookup_service_proc(ServiceRec, Method) of
- {ok, ServiceProc} ->
- invoke_service(PostOrGet, ServiceRec#service.handler,
- ModData, ServiceProc, Args, Timeout);
- not_found ->
- error_response(404, "Procedure not found", [ServiceName, Method])
- end
- end.
-
-expand_jsonrpc_reply(Reply = {result, _Value}) -> {[], Reply};
-expand_jsonrpc_reply(Reply = {error, _Value}) -> {[], Reply};
-expand_jsonrpc_reply({result, Value, Headers0}) -> {Headers0, {result, Value}};
-expand_jsonrpc_reply({error, Value, Headers0}) -> {Headers0, {error, Value}}.
-
-register_service(Pid, ServiceDescription) ->
- %%error_logger:info_msg("Registering ~p as ~p", [Pid, ServiceDescription]),
- gen_server:call(mod_jsonrpc, {register_service, Pid, ServiceDescription}).
-
-error_response(Code, ErrorValue) when is_integer(Code) ->
- error_response(Code, "Error "++integer_to_list(Code), ErrorValue);
-error_response(Message, ErrorValue) when is_list(Message) ->
- error_response(500, list_to_binary(Message), ErrorValue);
-error_response(Message, ErrorValue) when is_binary(Message) ->
- error_response(500, Message, ErrorValue).
-
-error_response(Code, Message, ErrorValue) when is_list(Message) ->
- error_response(Code, list_to_binary(Message), ErrorValue);
-error_response(Code, Message, ErrorValue) ->
- {error, {obj, [{"name", <<"JSONRPCError">>},
- {"code", Code},
- {"message", Message},
- {"error", ErrorValue}]}}.
-
-service(Handler, Name, Id, Version, Procs) ->
- (service(Name, Id, Version, Procs))#service{handler = Handler}.
-
-service(Name, Id, Version, Procs) when is_list(Name) ->
- service(list_to_binary(Name), Id, Version, Procs);
-service(Name, Id, Version, Procs) when is_list(Id) ->
- service(Name, list_to_binary(Id), Version, Procs);
-service(Name, Id, Version, Procs) when is_list(Version) ->
- service(Name, Id, list_to_binary(Version), Procs);
-service(Name, Id, Version, Procs) ->
- #service{name = Name, id = Id, version = Version,
- procs = lists:map(fun ({ProcName, Params}) ->
- proc(ProcName, Params);
- (P = #service_proc{}) ->
- P
- end, Procs)}.
-
-proc(Name, Params) when is_list(Name) ->
- proc(list_to_binary(Name), Params);
-proc(Name, Params) ->
- #service_proc{name = Name, params = lists:map(fun proc_param/1, Params)}.
-
-proc_param({N, T}) when is_list(N) ->
- proc_param({list_to_binary(N), T});
-proc_param({N, T}) ->
- #service_proc_param{name = N, type = proc_param_type(T)}.
-
-proc_param_type(bit) -> <<"bit">>;
-proc_param_type(num) -> <<"num">>;
-proc_param_type(str) -> <<"str">>;
-proc_param_type(arr) -> <<"arr">>;
-proc_param_type(obj) -> <<"obj">>;
-proc_param_type(any) -> <<"any">>;
-proc_param_type(nil) -> <<"nil">>;
-proc_param_type(T) when is_list(T) -> list_to_binary(T);
-proc_param_type(T) when is_binary(T) -> T.
-
-gen_object_name() ->
- Hash = erlang:md5(term_to_binary({node(), erlang:now()})),
- binary_to_hex(Hash).
-
-binary_to_hex(<<>>) ->
- [];
-binary_to_hex(<<B, Rest/binary>>) ->
- [rfc4627:hex_digit((B bsr 4) band 15),
- rfc4627:hex_digit(B band 15) |
- binary_to_hex(Rest)].
-
-service_address(ModData, Object) when is_binary(Object) ->
- service_address(ModData, binary_to_list(Object));
-service_address(#mod{socket_type = SocketType,
- config_db = ConfigDb,
- parsed_header = Headers},
- Object) ->
- AliasPrefix = httpd_util:lookup(ConfigDb, json_rpc_alias, "/jsonrpc"),
- Host = case httpd_util:key1search(Headers, "host") of
- undefined -> "";
- Name -> "//" ++ Name
- end,
- Scheme = case SocketType of
- ip_comm -> "http:";
- ssl -> "https:";
- _Other -> ""
- end,
- Scheme ++ Host ++ AliasPrefix ++ "/" ++ Object;
-service_address(_, Object) ->
- Object.
-
-extract_object_method_and_params(#mod{config_db = ConfigDb, request_uri = Uri}) ->
- AliasPrefix = httpd_util:lookup(ConfigDb, json_rpc_alias, "/jsonrpc"),
- AliasPrefixRe = "^" ++ AliasPrefix ++ "/",
- case regexp:first_match(Uri, AliasPrefixRe) of
- {match, 1, Length} ->
- Tail = string:substr(Uri, Length + 1),
- {ObjectMethod, Params} = case string:tokens(Tail, "?") of
- [] -> {"", ""};
- [Method] -> {Method, ""};
- [Method, QueryStr] -> {Method, QueryStr}
- end,
- case lists:reverse(string:tokens(ObjectMethod, "/")) of
- [] -> {"", "", Params};
- [Object] -> {list_to_binary(Object), <<>>, Params};
- [Method1, Object | _] -> {list_to_binary(Object), list_to_binary(Method1), Params}
- end;
- nomatch ->
- no_match
- end.
-
-extract_timeout_header(#mod{parsed_header = ParsedHeader}) ->
- case httpd_util:key1search(ParsedHeader, "x-json-rpc-timeout", "default") of
- "default" ->
- default;
- "infinity" ->
- infinity;
- NumStr ->
- list_to_integer(NumStr)
- end.
-
-parse_jsonrpc(ModData = #mod{method = "POST", entity_body = Body},
- {Object, _UriMethod, _UriParams}) ->
- {ok, {obj, Fields}, _} = rfc4627:decode(Body),
- {post,
- httpd_util:key1search(Fields, "id"),
- Object,
- httpd_util:key1search(Fields, "method"),
- httpd_util:key1search(Fields, "params"),
- extract_timeout_header(ModData)};
-parse_jsonrpc(ModData = #mod{method = _},
- {Object, Method, QueryStr}) ->
- %% GET, presumably. We don't really care, here.
- Q = case httpd:parse_query(QueryStr) of
- [{"",""}] -> []; %% is this a bug in httpd?
- ActualParameters -> ActualParameters
- end,
- {get,
- null,
- Object,
- Method,
- %% FIXME: need to collect duplicate parameter keys into a list, as per spec
- {obj, lists:map(fun ({Key, ValStr}) ->
- {Key, list_to_binary(ValStr)}
- end, Q)},
- extract_timeout_header(ModData)}.
-
-lookup_service_proc(#service{procs = Procs}, Method) ->
- case lists:keysearch(Method, #service_proc.name, Procs) of
- {value, ServiceProc} ->
- {ok, ServiceProc};
- false ->
- not_found
- end.
-
-invoke_service(get, Handler, ModData, ServiceProc, Args, Timeout) ->
- if
- ServiceProc#service_proc.idempotent ->
- invoke_service1(Handler, ModData, ServiceProc, Args, Timeout);
- true ->
- error_response(403, "Non-idempotent method", ServiceProc#service_proc.name)
- end;
-invoke_service(post, Handler, ModData, ServiceProc, Args, Timeout) ->
- invoke_service1(Handler, ModData, ServiceProc, Args, Timeout).
-
-invoke_service1(Handler, ModData, #service_proc{name = Name, params = Params}, Args, Timeout) ->
- %%error_logger:info_msg("JSONRPC invoking ~p:~p(~p)", [Handler, Name, Args]),
- case catch run_handler(Handler, Name, ModData, coerce_args(Params, Args), Timeout) of
- {'EXIT', {{function_clause, _}, _}} ->
- error_response(404, "Undefined procedure", Name);
- {'EXIT', Reason} ->
- error_response(500, "Internal error", list_to_binary(io_lib:format("~p", [Reason])));
- Response ->
- Response
- end.
-
-run_handler({pid, Pid}, Name, ModData, CoercedArgs, default) ->
- gen_server:call(Pid, {jsonrpc, Name, ModData, CoercedArgs});
-run_handler({pid, Pid}, Name, ModData, CoercedArgs, Timeout) ->
- gen_server:call(Pid, {jsonrpc, Name, ModData, CoercedArgs}, Timeout);
-run_handler({function, F}, Name, ModData, CoercedArgs, _Timeout) ->
- F(Name, ModData, CoercedArgs).
-
-coerce_args(_Params, Args) when is_list(Args) ->
- Args;
-coerce_args(Params, {obj, Fields}) ->
- lists:map(fun (#service_proc_param{name = Name, type = Type}) ->
- case lists:keysearch(binary_to_list(Name), 1, Fields) of
- {value, {_, Value}} ->
- coerce_value(Value, Type);
- false ->
- null
- end
- end, Params).
-
-coerce_value(Value, _Type) when not(is_binary(Value)) ->
- Value;
-coerce_value(<<"true">>, <<"bit">>) -> true;
-coerce_value(_, <<"bit">>) -> false;
-coerce_value(V, <<"num">>) -> list_to_integer(binary_to_list(V));
-coerce_value(V, <<"str">>) -> V;
-coerce_value(V, <<"arr">>) -> rfc4627:decode(V);
-coerce_value(V, <<"obj">>) -> rfc4627:decode(V);
-coerce_value(V, <<"any">>) -> V;
-coerce_value(_, <<"nil">>) -> null;
-coerce_value(V, _) -> V.
-
-remove_undefined({obj, Fields}) ->
- {obj, remove_undefined1(Fields)}.
-
-remove_undefined1([]) ->
- [];
-remove_undefined1([{_, undefined} | Rest]) ->
- remove_undefined1(Rest);
-remove_undefined1([X | Rest]) ->
- [X | remove_undefined1(Rest)].
-
-system_describe(AddressStr,
- #service{name = Name, id = Id, version = Version, summary = Summary,
- help = Help, procs = Procs}) ->
- remove_undefined({obj, [{"sdversion", <<"1.0">>},
- {"name", Name},
- {"id", Id},
- {"version", Version},
- {"summary", Summary},
- {"help", Help},
- {"address", list_to_binary(AddressStr)},
- {"procs", lists:map(fun system_describe_proc/1, Procs)}]}).
-
-system_describe_proc(P = #service_proc{params = Params}) ->
- remove_undefined(?RFC4627_FROM_RECORD(service_proc,
- P#service_proc{params =
- lists:map(fun system_describe_proc_param/1,
- Params)})).
-
-system_describe_proc_param(P = #service_proc_param{}) ->
- remove_undefined(?RFC4627_FROM_RECORD(service_proc_param, P)).
-
-%---------------------------------------------------------------------------
-
-init(_Args) ->
- {ok, no_jsonrpc_state}.
-
-terminate(_Reason, _State) ->
- %% FIXME: should we notify services here?
- ok.
-
-code_change(_OldVsn, State, _Extra) ->
- State.
-
-handle_call({lookup_service, Service}, _From, State) ->
- case get({service, Service}) of
- undefined ->
- {reply, not_found, State};
- ServiceRec ->
- {reply, ServiceRec, State}
- end;
-
-handle_call({register_service, Pid, ServiceDescription}, _From, State) ->
- SD = ServiceDescription#service{handler = {pid, Pid}},
- erlang:monitor(process, Pid),
- put({service_pid, Pid}, SD#service.name),
- put({service, SD#service.name}, SD),
- {reply, ok, State}.
-
-handle_cast(Request, State) ->
- error_logger:error_msg("Unhandled cast in mod_jsonrpc: ~p", [Request]),
- {noreply, State}.
-
-handle_info({'DOWN', _MonitorRef, process, DownPid, _Reason}, State) ->
- case get({service_pid, DownPid}) of
- undefined ->
- %% How strange.
- {noreply, State};
- ServiceName ->
- erase({service_pid, DownPid}),
- erase({service, ServiceName}),
- {noreply, State}
- end.
View
284 src/rfc4627_jsonrpc.erl
@@ -0,0 +1,284 @@
+%% JSON-RPC, transport-neutral.
+%%---------------------------------------------------------------------------
+%% Copyright (c) 2007, 2008 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
+%% Copyright (c) 2007, 2008 LShift Ltd. <query@lshift.net>
+%%
+%% Permission is hereby granted, free of charge, to any person
+%% obtaining a copy of this software and associated documentation
+%% files (the "Software"), to deal in the Software without
+%% restriction, including without limitation the rights to use, copy,
+%% modify, merge, publish, distribute, sublicense, and/or sell copies
+%% of the Software, and to permit persons to whom the Software is
+%% furnished to do so, subject to the following conditions:
+%%
+%% The above copyright notice and this permission notice shall be
+%% included in all copies or substantial portions of the Software.
+%%
+%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+%% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+%% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+%% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+%% SOFTWARE.
+%%---------------------------------------------------------------------------
+
+-module(rfc4627_jsonrpc).
+-include("rfc4627.hrl").
+-include("rfc4627_jsonrpc.hrl").
+
+-behaviour(gen_server).
+
+-export([start/0, start_link/0]).
+-export([init/1, terminate/2, code_change/3, handle_call/3, handle_cast/2, handle_info/2]).
+
+-export([lookup_service/1, register_service/2]).
+-export([gen_object_name/0, system_describe/2]).
+-export([jsonrpc_post/3, jsonrpc_post/4, invoke_service_method/8, expand_jsonrpc_reply/2]).
+-export([error_response/2, error_response/3, service/4, service/5, proc/2]).
+
+-define(SERVICE, ?MODULE).
+
+start() ->
+ gen_server:start({local, ?SERVICE}, ?MODULE, [], []).
+
+start_link() ->
+ gen_server:start_link({local, ?SERVICE}, ?MODULE, [], []).
+
+lookup_service(Service) ->
+ gen_server:call(?SERVICE, {lookup_service, Service}).
+
+register_service(Pid, ServiceDescription) ->
+ %%error_logger:info_msg("Registering ~p as ~p", [Pid, ServiceDescription]),
+ gen_server:call(?SERVICE, {register_service, Pid, ServiceDescription}).
+
+gen_object_name() ->
+ Hash = erlang:md5(term_to_binary({node(), erlang:now()})),
+ binary_to_hex(Hash).
+
+system_describe(EndpointAddress,
+ #service{name = Name, id = Id, version = Version, summary = Summary,
+ help = Help, procs = Procs}) ->
+ remove_undefined({obj, [{"sdversion", <<"1.0">>},
+ {"name", Name},
+ {"id", Id},
+ {"version", Version},
+ {"summary", Summary},
+ {"help", Help},
+ {"address", EndpointAddress},
+ {"procs", [system_describe_proc(P) || P <- Procs]}]}).
+
+jsonrpc_post(ServiceRec, RequestInfo, RequestObj) ->
+ jsonrpc_post(ServiceRec, RequestInfo, RequestObj, default).
+
+jsonrpc_post(ServiceRec, RequestInfo, RequestObj, Timeout) ->
+ Id = rfc4627:get_field(RequestObj, "id", undefined),
+ Method = rfc4627:get_field(RequestObj, "method", undefined),
+ Args = rfc4627:get_field(RequestObj, "params", undefined),
+ invoke_service_method(ServiceRec, Id, post, RequestInfo, undefined, Method, Args, Timeout).
+
+invoke_service_method(ServiceRec = #service{}, RequestId,
+ PostOrGet, RequestInfo, EndpointAddress, Method, Args, Timeout) ->
+ expand_jsonrpc_reply(
+ RequestId,
+ case Method of
+ <<"system.describe">> ->
+ {result, system_describe(EndpointAddress, ServiceRec)};
+ <<"system.", _Rest/binary>> ->
+ error_response(403, "System methods forbidden", Method);
+ _ ->
+ case lookup_service_proc(ServiceRec, Method) of
+ {ok, ServiceProc} ->
+ invoke_service(PostOrGet, ServiceRec#service.handler,
+ RequestInfo, ServiceProc, Args, Timeout);
+ not_found ->
+ error_response(404, "Procedure not found", [EndpointAddress, Method])
+ end
+ end).
+
+error_response(Code, ErrorValue) when is_integer(Code) ->
+ error_response(Code, "Error "++integer_to_list(Code), ErrorValue);
+error_response(Message, ErrorValue) when is_list(Message) ->
+ error_response(500, list_to_binary(Message), ErrorValue);
+error_response(Message, ErrorValue) when is_binary(Message) ->
+ error_response(500, Message, ErrorValue).
+
+error_response(Code, Message, ErrorValue) when is_list(Message) ->
+ error_response(Code, list_to_binary(Message), ErrorValue);
+error_response(Code, Message, ErrorValue) ->
+ {error, {obj, [{"name", <<"JSONRPCError">>},
+ {"code", Code},
+ {"message", Message},
+ {"error", ErrorValue}]}}.
+
+service(Name, Id, Version, Procs) when is_list(Name) ->
+ service(list_to_binary(Name), Id, Version, Procs);
+service(Name, Id, Version, Procs) when is_list(Id) ->
+ service(Name, list_to_binary(Id), Version, Procs);
+service(Name, Id, Version, Procs) when is_list(Version) ->
+ service(Name, Id, list_to_binary(Version), Procs);
+service(Name, Id, Version, Procs) ->
+ #service{name = Name, id = Id, version = Version,
+ procs = [case P of
+ {ProcName, Params} -> proc(ProcName, Params);
+ #service_proc{} -> P
+ end || P <- Procs]}.
+
+service(Handler, Name, Id, Version, Procs) ->
+ (service(Name, Id, Version, Procs))#service{handler = Handler}.
+
+proc(Name, Params) when is_list(Name) ->
+ proc(list_to_binary(Name), Params);
+proc(Name, Params) ->
+ #service_proc{name = Name, params = [proc_param(P) || P <- Params]}.
+
+%---------------------------------------------------------------------------
+
+build_jsonrpc_response(Id, ResultField) ->
+ {obj, [{version, <<"1.1">>},
+ {id, Id},
+ ResultField]}.
+
+expand_jsonrpc_reply(RequestId, {ResultOrError, Value}) ->
+ {ResultOrError, build_jsonrpc_response(RequestId, {ResultOrError, Value}), {obj, []}};
+expand_jsonrpc_reply(RequestId, {ResultOrError, Value, ResponseInfo}) ->
+ {ResultOrError, build_jsonrpc_response(RequestId, {ResultOrError, Value}), ResponseInfo}.
+
+proc_param({N, T}) when is_list(N) ->
+ proc_param({list_to_binary(N), T});
+proc_param({N, T}) ->
+ #service_proc_param{name = N, type = proc_param_type(T)}.
+
+proc_param_type(bit) -> <<"bit">>;
+proc_param_type(num) -> <<"num">>;
+proc_param_type(str) -> <<"str">>;
+proc_param_type(arr) -> <<"arr">>;
+proc_param_type(obj) -> <<"obj">>;
+proc_param_type(any) -> <<"any">>;
+proc_param_type(nil) -> <<"nil">>;
+proc_param_type(T) when is_list(T) -> list_to_binary(T);
+proc_param_type(T) when is_binary(T) -> T.
+
+binary_to_hex(<<>>) ->
+ [];
+binary_to_hex(<<B, Rest/binary>>) ->
+ [rfc4627:hex_digit((B bsr 4) band 15),
+ rfc4627:hex_digit(B band 15) |
+ binary_to_hex(Rest)].
+
+lookup_service_proc(#service{procs = Procs}, Method) ->
+ case lists:keysearch(Method, #service_proc.name, Procs) of
+ {value, ServiceProc} ->
+ {ok, ServiceProc};
+ false ->
+ not_found
+ end.
+
+invoke_service(get, Handler, RequestInfo, ServiceProc, Args, Timeout) ->
+ if
+ ServiceProc#service_proc.idempotent ->
+ invoke_service1(Handler, RequestInfo, ServiceProc, Args, Timeout);
+ true ->
+ error_response(403, "Non-idempotent method", ServiceProc#service_proc.name)
+ end;
+invoke_service(post, Handler, RequestInfo, ServiceProc, Args, Timeout) ->
+ invoke_service1(Handler, RequestInfo, ServiceProc, Args, Timeout).
+
+invoke_service1(Handler, RequestInfo, #service_proc{name = Name, params = Params}, Args, Timeout) ->
+ %%error_logger:info_msg("JSONRPC invoking ~p:~p(~p)", [Handler, Name, Args]),
+ case catch run_handler(Handler, Name, RequestInfo, coerce_args(Params, Args), Timeout) of
+ {'EXIT', {{function_clause, _}, _}} ->
+ error_response(404, "Undefined procedure", Name);
+ {'EXIT', Reason} ->
+ error_response(500, "Internal error", list_to_binary(io_lib:format("~p", [Reason])));
+ Response ->
+ Response
+ end.
+
+run_handler({pid, Pid}, Name, RequestInfo, CoercedArgs, default) ->
+ gen_server:call(Pid, {jsonrpc, Name, RequestInfo, CoercedArgs});
+run_handler({pid, Pid}, Name, RequestInfo, CoercedArgs, Timeout) ->
+ gen_server:call(Pid, {jsonrpc, Name, RequestInfo, CoercedArgs}, Timeout);
+run_handler({function, F}, Name, RequestInfo, CoercedArgs, _Timeout) ->
+ F(Name, RequestInfo, CoercedArgs).
+
+coerce_args(_Params, Args) when is_list(Args) ->
+ Args;
+coerce_args(Params, {obj, Fields}) ->
+ [case lists:keysearch(binary_to_list(Name), 1, Fields) of
+ {value, {_, Value}} -> coerce_value(Value, Type);
+ false -> null
+ end || #service_proc_param{name = Name, type = Type} <- Params].
+
+coerce_value(Value, _Type) when not(is_binary(Value)) ->
+ Value;
+coerce_value(<<"true">>, <<"bit">>) -> true;
+coerce_value(_, <<"bit">>) -> false;
+coerce_value(V, <<"num">>) -> list_to_integer(binary_to_list(V));
+coerce_value(V, <<"str">>) -> V;
+coerce_value(V, <<"arr">>) -> rfc4627:decode(V);
+coerce_value(V, <<"obj">>) -> rfc4627:decode(V);
+coerce_value(V, <<"any">>) -> V;
+coerce_value(_, <<"nil">>) -> null;
+coerce_value(V, _) -> V.
+
+remove_undefined({obj, Fields}) ->
+ {obj, remove_undefined1(Fields)}.
+
+remove_undefined1([]) ->
+ [];
+remove_undefined1([{_, undefined} | Rest]) ->
+ remove_undefined1(Rest);
+remove_undefined1([X | Rest]) ->
+ [X | remove_undefined1(Rest)].
+
+system_describe_proc(P = #service_proc{params = Params}) ->
+ remove_undefined(?RFC4627_FROM_RECORD(service_proc,
+ P#service_proc{params = [system_describe_proc_param(A)
+ || A <- Params]})).
+
+system_describe_proc_param(P = #service_proc_param{}) ->
+ remove_undefined(?RFC4627_FROM_RECORD(service_proc_param, P)).
+
+%---------------------------------------------------------------------------
+
+init(_Args) ->
+ {ok, no_jsonrpc_state}.
+
+terminate(_Reason, _State) ->
+ %% FIXME: should we notify services here?
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ State.
+
+handle_call({lookup_service, Service}, _From, State) ->
+ case get({service, Service}) of
+ undefined ->
+ {reply, not_found, State};
+ ServiceRec ->
+ {reply, ServiceRec, State}
+ end;
+
+handle_call({register_service, Pid, ServiceDescription}, _From, State) ->
+ SD = ServiceDescription#service{handler = {pid, Pid}},
+ erlang:monitor(process, Pid),
+ put({service_pid, Pid}, SD#service.name),
+ put({service, SD#service.name}, SD),
+ {reply, ok, State}.
+
+handle_cast(Request, State) ->
+ error_logger:error_msg("Unhandled cast in ~p: ~p", [?MODULE, Request]),
+ {noreply, State}.
+
+handle_info({'DOWN', _MonitorRef, process, DownPid, _Reason}, State) ->
+ case get({service_pid, DownPid}) of
+ undefined ->
+ %% How strange.
+ {noreply, State};
+ ServiceName ->
+ erase({service_pid, DownPid}),
+ erase({service, ServiceName}),
+ {noreply, State}
+ end.
View
117 src/rfc4627_jsonrpc_http.erl
@@ -0,0 +1,117 @@
+%% JSON-RPC for HTTP transports (inets, mochiweb, yaws, ...)
+%%---------------------------------------------------------------------------
+%% Copyright (c) 2007, 2008 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
+%% Copyright (c) 2007, 2008 LShift Ltd. <query@lshift.net>
+%%
+%% Permission is hereby granted, free of charge, to any person
+%% obtaining a copy of this software and associated documentation
+%% files (the "Software"), to deal in the Software without
+%% restriction, including without limitation the rights to use, copy,
+%% modify, merge, publish, distribute, sublicense, and/or sell copies
+%% of the Software, and to permit persons to whom the Software is
+%% furnished to do so, subject to the following conditions:
+%%
+%% The above copyright notice and this permission notice shall be
+%% included in all copies or substantial portions of the Software.
+%%
+%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+%% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+%% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+%% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+%% SOFTWARE.
+%%---------------------------------------------------------------------------
+
+-module(rfc4627_jsonrpc_http).
+-include("rfc4627_jsonrpc.hrl").
+
+-export([invoke_service_method/4]).
+
+invoke_service_method(default, Path, RequestInfo, Body) ->
+ invoke_service_method("/jsonrpc", Path, RequestInfo, Body);
+invoke_service_method(AliasPrefix, Path, RequestInfo, Body) ->
+ case parse_jsonrpc(AliasPrefix,
+ Path,
+ rfc4627:get_field(RequestInfo, "http_method", <<"GET">>),
+ rfc4627:get_field(RequestInfo, "http_query_parameters", {obj, []}),
+ Body) of
+ no_match ->
+ no_match;
+ {PostOrGet, Id, Service, Method, Args} ->
+ {_ResultOrError, Result, ResponseInfo} =
+ case rfc4627_jsonrpc:lookup_service(Service) of
+ not_found ->
+ Err = rfc4627_jsonrpc:error_response(404, "Service not found", Service),
+ rfc4627_jsonrpc:expand_jsonrpc_reply(Id, Err);
+ ServiceRec ->
+ HttpHeaders = rfc4627:get_field(RequestInfo, "http_headers", {obj, []}),
+ Timeout = extract_timeout_header(HttpHeaders),
+ EndpointAddress = service_address(AliasPrefix, RequestInfo, Service),
+ rfc4627_jsonrpc:invoke_service_method(
+ ServiceRec, Id,
+ PostOrGet, RequestInfo, EndpointAddress, Method, Args, Timeout)
+ end,
+ ResultEnc = lists:flatten(rfc4627:encode(Result)),
+ {ok, ResultEnc, ResponseInfo}
+ end.
+
+extract_timeout_header(HeadersJsonObj) ->
+ case rfc4627:get_field(HeadersJsonObj, "x-json-rpc-timeout", <<"default">>) of
+ <<"default">> ->
+ default;
+ <<"infinity">> ->
+ infinity;
+ Other ->
+ list_to_integer(binary_to_list(Other))
+ end.
+
+extract_object_and_method(AliasPrefix, Path) ->
+ AliasPrefixRe = "^" ++ AliasPrefix ++ "/",
+ case regexp:first_match(Path, AliasPrefixRe) of
+ {match, 1, Length} ->
+ ObjectMethod = string:substr(Path, Length + 1),
+ case lists:reverse(string:tokens(ObjectMethod, "/")) of
+ [] -> {<<>>, <<>>};
+ [Object] -> {list_to_binary(Object), <<>>};
+ [Method1, Object | _] -> {list_to_binary(Object), list_to_binary(Method1)}
+ end;
+ nomatch ->
+ no_match
+ end.
+
+parse_jsonrpc(AliasPrefix, Path, HttpMethod, QueryParametersObj, Body) ->
+ case extract_object_and_method(AliasPrefix, Path) of
+ no_match ->
+ no_match;
+ {Object, PathMethod} ->
+ case HttpMethod of
+ <<"POST">> ->
+ {ok, RequestObject, _} = rfc4627:decode(Body),
+ {post,
+ rfc4627:get_field(RequestObject, "id", null),
+ Object,
+ rfc4627:get_field(RequestObject, "method", undefined),
+ rfc4627:get_field(RequestObject, "params", undefined)};
+ _ ->
+ %% GET, presumably. We don't really care, here.
+ {get,
+ null,
+ Object,
+ PathMethod,
+ QueryParametersObj}
+ end
+ end.
+
+service_address(AliasPrefix, RequestInfo, ServiceName) ->
+ HttpHeaders = rfc4627:get_field(RequestInfo, "http_headers", {obj, []}),
+ Host = case rfc4627:get_field(HttpHeaders, "host", undefined) of
+ undefined -> "";
+ Name -> "//" ++ binary_to_list(Name)
+ end,
+ Scheme = case rfc4627:get_field(RequestInfo, "scheme", undefined) of
+ undefined -> "";
+ S -> binary_to_list(S) ++ ":"
+ end,
+ list_to_binary(Scheme ++ Host ++ AliasPrefix ++ "/" ++ binary_to_list(ServiceName)).
View
89 src/rfc4627_jsonrpc_inets.erl
@@ -0,0 +1,89 @@
+%% JSON-RPC for Erlang's inets httpd
+%%---------------------------------------------------------------------------
+%% Copyright (c) 2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
+%% Copyright (c) 2007 LShift Ltd. <query@lshift.net>
+%%
+%% Permission is hereby granted, free of charge, to any person
+%% obtaining a copy of this software and associated documentation
+%% files (the "Software"), to deal in the Software without
+%% restriction, including without limitation the rights to use, copy,
+%% modify, merge, publish, distribute, sublicense, and/or sell copies
+%% of the Software, and to permit persons to whom the Software is
+%% furnished to do so, subject to the following conditions:
+%%
+%% The above copyright notice and this permission notice shall be
+%% included in all copies or substantial portions of the Software.
+%%
+%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+%% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+%% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+%% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+%% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+%% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+%% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+%% SOFTWARE.
+%%---------------------------------------------------------------------------
+
+-module(rfc4627_jsonrpc_inets).
+-include("rfc4627_jsonrpc.hrl").
+-include_lib("inets/src/httpd.hrl").
+
+-export([do/1, load/2]).
+
+do(ModData = #mod{data = OldData}) ->
+ case {proplists:get_value(status, OldData),
+ proplists:get_value(response, OldData)} of
+ {undefined, undefined} ->
+ do_rpc(ModData);
+ _ ->
+ {proceed, OldData}
+ end.
+
+load("JsonRpcAlias " ++ Alias, []) ->
+ {ok, [], {json_rpc_alias, Alias}}.
+
+do_rpc(#mod{config_db = ConfigDb,
+ socket_type = SocketType,
+ method = HttpMethod,
+ request_uri = PathAndQuery,
+ parsed_header = InetsHeaders,
+ entity_body = Body,
+ data = OldData}) ->
+ AliasPrefix = httpd_util:lookup(ConfigDb, json_rpc_alias, default),
+ {Path, QueryObj} = case string:tokens(PathAndQuery, "?") of
+ [] -> {"", {obj, []}};
+ [P] -> {P, {obj, []}};
+ [P, Q] -> {P, {obj, case httpd:parse_query(Q) of
+ [{"",""}] -> []; %% is this a bug in httpd?
+ KV -> [{K, list_to_binary(V)} || {K,V} <- KV]
+ end}}
+ end,
+ HeaderObj = {obj, [{K, list_to_binary(V)} || {K,V} <- InetsHeaders]},
+ SchemeFields = case SocketType of
+ ip_comm -> [{"scheme", <<"http">>}];
+ ssl -> [{"scheme", <<"https">>}];
+ _ -> []
+ end,
+
+ RequestInfo = {obj, ([{"http_method", list_to_binary(HttpMethod)},
+ {"http_query_parameters", QueryObj},
+ {"http_headers", HeaderObj}]
+ ++ SchemeFields)},
+
+ case rfc4627_jsonrpc_http:invoke_service_method(AliasPrefix,
+ Path,
+ RequestInfo,
+ Body) of
+ no_match ->
+ {proceed, OldData};
+ {ok, ResultEnc, ResponseInfo} ->
+ {obj, ResponseHeaderFields} =
+ rfc4627:get_field(ResponseInfo, "http_headers", {obj, []}),
+ Headers = [{K, binary_to_list(V)} || {K,V} <- ResponseHeaderFields],
+ {proceed, [{response, {response,
+ [{code, 200},
+ {content_length, integer_to_list(length(ResultEnc))},
+ {content_type, "text/plain"}%rfc4627:mime_type()}
+ | Headers],
+ ResultEnc}} | OldData]}
+ end.
View
2 test/server_root/conf/httpd.conf
@@ -4,7 +4,7 @@ DocumentRoot test/server_root/htdocs
Port 5671
-Modules mod_alias mod_auth mod_jsonrpc mod_actions mod_cgi mod_responsecontrol mod_trace mod_range mod_head mod_include mod_dir mod_get mod_log mod_disk_log
+Modules mod_alias mod_auth rfc4627_jsonrpc_inets mod_actions mod_cgi mod_responsecontrol mod_trace mod_range mod_head mod_include mod_dir mod_get mod_log mod_disk_log
DirectoryIndex index.html
View
23 test/test_jsonrpc.erl → test/test_jsonrpc_inets.erl
@@ -24,10 +24,9 @@
%% SOFTWARE.
%%---------------------------------------------------------------------------
--module(test_jsonrpc).
+-module(test_jsonrpc_inets).
--include("rfc4627.hrl").
--include("mod_jsonrpc.hrl").
+-include("rfc4627_jsonrpc.hrl").
-behaviour(gen_server).
@@ -36,19 +35,19 @@
start() ->
{ok, Pid} = gen_server:start(?MODULE, [], []),
- mod_jsonrpc:register_service
+ rfc4627_jsonrpc:register_service
(Pid,
- mod_jsonrpc:service(<<"test">>,
- <<"urn:uuid:afe1b4b5-23b0-4964-a74a-9168535c96b2">>,
- <<"1.0">>,
- [#service_proc{name = <<"test_proc">>,
- idempotent = true,
- params = [#service_proc_param{name = <<"value">>,
- type = <<"str">>}]}])).
+ rfc4627_jsonrpc:service(<<"test">>,
+ <<"urn:uuid:afe1b4b5-23b0-4964-a74a-9168535c96b2">>,
+ <<"1.0">>,
+ [#service_proc{name = <<"test_proc">>,
+ idempotent = true,
+ params = [#service_proc_param{name = <<"value">>,
+ type = <<"str">>}]}])).
start_httpd() ->
+ rfc4627_jsonrpc:start(),
httpd:start("test/server_root/conf/httpd.conf"),
- mod_jsonrpc:start(),
start().
%---------------------------------------------------------------------------

0 comments on commit 21d93e0

Please sign in to comment.