# 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 ++--
xen-api-libs.hg-17.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home