[rpc-light] Make the abstraction layer more uniform, especially for the error handling.

Indeed, XMLRPC and JSONRPC are a bit different on error handling, but abstract these minor differences away.

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@citrix.com>

diff --git a/rpc-light/jsonrpc.ml b/rpc-light/jsonrpc.ml
index 484e6264b74b9db01773d20b1aa98e085c0a2104..3454c6ef732f73e5d09baf565903982935eaa0d6 100644 (file)
--- a/rpc-light/jsonrpc.ml
+++ b/rpc-light/jsonrpc.ml
@@ -78,19 +78,19 @@ let string_of_call call =
        ] in
        to_string json
 
-let string_of_response id response =
-       let json = match response with
-               | Success v ->
+let string_of_response response =
+       let json =
+               if response.Rpc.success then
                        `Dict [
-                               "result", v;
+                               "result", response.Rpc.contents;
                                "error", `None;
-                               "id", `Int id
+                               "id", `Int 0L
                        ]
-               | Fault f ->
+               else
                        `Dict [
                                "result", `None;
-                               "error", f;
-                               "id", `Int id
+                               "error", response.Rpc.contents;
+                               "id", `Int 0L
                        ] in
        to_string json
 
@@ -500,8 +500,8 @@ let call_of_string str =
        | `Dict d ->
                let name = match get "method" d with `String s -> s | _ -> raise (Malformed_method_request str) in
                let params = match get "params" d with `List l -> l | _ -> raise (Malformed_method_request str) in
-               let id = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_request str) in
-               id, { name = name; params = params }
+               let (_:int64) = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_request str) in
+               { name = name; params = params }
        | _ -> raise (Malformed_method_request str)
 
 let response_of_string str =
@@ -509,11 +509,11 @@ let response_of_string str =
        | `Dict d ->
                  let result = get "result" d in
                  let error = get "error" d in
-                 let id = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_response str) in
+                 let (_:int64) = match get "id" d with `Int i -> i | _ -> raise (Malformed_method_response str) in
                  begin match result, error with
                          | `None, `None -> raise (Malformed_method_response str)
-                         | `None, v     -> id, Fault v
-                         | v, `None     -> id, Success v
+                         | `None, v     -> { Rpc.success = false; contents = v }
+                         | v, `None     -> { Rpc.success = true;  contents = v }
                          | _            -> raise (Malformed_method_response str)
                  end
        | _ -> raise (Malformed_method_response str)

diff --git a/rpc-light/jsonrpc.mli b/rpc-light/jsonrpc.mli
index dd56dfc441fa63f837c59766ca0aeaedfc199105..c0aadd3da4ecb0dd1e4b480a52fa6d5db5faacec 100644 (file)
--- a/rpc-light/jsonrpc.mli
+++ b/rpc-light/jsonrpc.mli
@@ -16,10 +16,10 @@ val to_string : Rpc.Val.t -> string
 val of_string : string -> Rpc.Val.t
 
 val string_of_call: Rpc.call -> string
-val call_of_string: string -> int64 * Rpc.call
+val call_of_string: string -> Rpc.call
 
-val string_of_response: int64 -> Rpc.Val.t Rpc.response -> string
-val response_of_string: string -> int64 * Rpc.Val.t Rpc.response
+val string_of_response: Rpc.response -> string
+val response_of_string: string -> Rpc.response
 
 
 

diff --git a/rpc-light/rpc.ml b/rpc-light/rpc.ml
index 9d76ba5aefd537307d58608707db64f9586eb483..0e2dfeaa769c6f80ff5080dcd738034945efdb75 100644 (file)
--- a/rpc-light/rpc.ml
+++ b/rpc-light/rpc.ml
@@ -49,6 +49,7 @@ type call = {
        params: Val.t list
 }
 
-type 'a response =
-       | Success of Val.t
-       | Fault of 'a
+type response = {
+       success: bool;
+       contents: Val.t
+}

diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml
index 327320557dd6db941e17c5d4350cee2ff58b3a27..cb79bf07b99e3c741942c1bb0df354ffdf6efe85 100644 (file)
--- a/rpc-light/xmlrpc.ml
+++ b/rpc-light/xmlrpc.ml
@@ -96,18 +96,10 @@ let string_of_response response =
        let module B = Buffer in
        let buf = B.create 256 in
        let add = B.add_string buf in
-       begin match response with
-       | Rpc.Success v   ->
-               add "<?xml version=\"1.0\"?><methodResponse><params><param>";
-               add (to_string v);
-               add "</param></params></methodResponse>";
-       | Rpc.Fault (i,s) ->
-               add "<?xml version=\"1.0\"?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>";
-               add (Int64.to_string i);
-               add "</int></value></member><member><name>faultString</name><value><string>";
-               add s;
-               add "</string></value></member></struct></value></fault></methodResponse>";
-       end;
+       let v = `Dict [ (if response.Rpc.success then "success" else "failure"), response.Rpc.contents ] in
+       add "<?xml version=\"1.0\"?><methodResponse><params><param>";
+       add (to_string v);
+       add "</param></params></methodResponse>";
        B.contents buf
 
 exception Parse_error of string * Xmlm.signal * Xmlm.input
@@ -294,19 +286,15 @@ let response_of_string ?callback str =
        | `Dtd _ -> ignore (Xmlm.input input)
        | _      -> () end;
        Parser.map_tag "methodResponse" (fun input ->
-               match Xmlm.peek input with
-               | `El_start ((_,"fault"),_) ->
-                       Parser.map_tag "fault" (fun input ->
+               Parser.map_tag "params" (fun input ->
+                       Parser.map_tag "param" (fun input ->
                                let signal = Xmlm.peek input in
                                match Parser.of_xml ?callback [] input with
-                                       | `Dict [ "faultCode", `Int i; "faultString", `String s ] -> Rpc.Fault (i, s)
-                                       | s -> parse_error (to_string s) signal input
-                               ) input
-               | `El_start ((_,"params"),_) ->
-                       Parser.map_tag "params" (fun input ->
-                               Parser.map_tag "param" (fun input -> Rpc.Success (Parser.of_xml ?callback [] input)) input
+                               | `Dict [ "success", v ] -> { Rpc.success = true;  Rpc.contents = v }
+                               | `Dict [ "failure", v ] -> { Rpc.success = false; Rpc.contents = v }
+                               | v -> parse_error "response" signal input
                                ) input
-               | s -> parse_error "response" s input
-               ) input 
+                       ) input
+               ) input
 
        

diff --git a/rpc-light/xmlrpc.mli b/rpc-light/xmlrpc.mli
index 5a5a14cb3776d6625b49c98c1046565d9a5e3d6c..4643ec27ebba630dd6cb300ad6619280913120e1 100644 (file)
--- a/rpc-light/xmlrpc.mli
+++ b/rpc-light/xmlrpc.mli
@@ -18,5 +18,5 @@ val of_string : ?callback:Rpc.callback -> string -> Rpc.Val.t
 val string_of_call: Rpc.call -> string
 val call_of_string: ?callback:Rpc.callback -> string -> Rpc.call
 
-val string_of_response: (int64 * string) Rpc.response -> string
-val response_of_string: ?callback:Rpc.callback -> string -> (int64 * string) Rpc.response
+val string_of_response: Rpc.response -> string
+val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response