[Xen-API] [PATCH 01 of 17] [rpc-light] Make the abstraction layer more uniform, especially for the error handling

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 5158e68dfc6b17a197655390b0301bfd6fa603ea
# Parent  cbb5fc1d4be43b9a9a9243a551538d33ac909ef0
[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@xxxxxxxxxx>

diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/jsonrpc.ml
--- a/rpc-light/jsonrpc.ml      Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/jsonrpc.ml      Fri Jan 08 13:47:46 2010 +0000
@@ -78,19 +78,19 @@
        ] 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 @@
        | `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 @@
        | `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 -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/jsonrpc.mli
--- a/rpc-light/jsonrpc.mli     Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/jsonrpc.mli     Fri Jan 08 13:47:46 2010 +0000
@@ -16,10 +16,10 @@
 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 -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/rpc.ml
--- a/rpc-light/rpc.ml  Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/rpc.ml  Fri Jan 08 13:47:46 2010 +0000
@@ -49,6 +49,7 @@
        params: Val.t list
 }
 
-type 'a response =
-       | Success of Val.t
-       | Fault of 'a
+type response = {
+       success: bool;
+       contents: Val.t
+}
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml       Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.ml       Fri Jan 08 13:47:46 2010 +0000
@@ -96,18 +96,10 @@
        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 @@
        | `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
+                               | `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
-               | `El_start ((_,"params"),_) ->
-                       Parser.map_tag "params" (fun input ->
-                               Parser.map_tag "param" (fun input -> 
Rpc.Success (Parser.of_xml ?callback [] input)) input
-                               ) input
-               | s -> parse_error "response" s input
-               ) input 
+                       ) input
+               ) input
 
        
diff -r cbb5fc1d4be4 -r 5158e68dfc6b rpc-light/xmlrpc.mli
--- a/rpc-light/xmlrpc.mli      Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/xmlrpc.mli      Fri Jan 08 13:47:46 2010 +0000
@@ -18,5 +18,5 @@
 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
5 files changed, 33 insertions(+), 44 deletions(-)
rpc-light/jsonrpc.ml  |   26 +++++++++++++-------------
rpc-light/jsonrpc.mli |    6 +++---
rpc-light/rpc.ml      |    7 ++++---
rpc-light/xmlrpc.ml   |   34 +++++++++++-----------------------
rpc-light/xmlrpc.mli  |    4 ++--

Attachment: xen-api-libs.hg-17.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api