let x2 = x_of_rpc (Xmlrpc.of_string ~callback xml) in
let x3 = x_of_rpc (Jsonrpc.of_string json) in
- Printf.printf "\nSanity check:\nx1=x2: %b\nx2=x3: %b\nx1=x3: %b\n\n" (x1 = x2) (x2 = x3) (x1 = x3);
+ Printf.printf "\nSanity check 1:\nx1=x2: %b\nx2=x3: %b\nx1=x3: %b\n\n" (x1 = x2) (x2 = x3) (x1 = x3);
let call = { Rpc.name = "foo"; Rpc.params = [ rpc ] } in
let response1 = Rpc.Success rpc in
let response2 = Rpc.Fault (1L, "Foo") in
+ let response3 = Rpc.Fault rpc in
let c1 = Xmlrpc.string_of_call call in
let r1 = Xmlrpc.string_of_response response1 in
let r2 = Xmlrpc.string_of_response response2 in
- Printf.printf "call: %s\n" c1;
- Printf.printf "response1: %s\n" r1;
+ let cj1 = Jsonrpc.string_of_call call in
+ let rj1 = Jsonrpc.string_of_response 0L response1 in
+ let rj3 = Jsonrpc.string_of_response 0L response3 in
+
+ Printf.printf "call: %s\n%s\n" c1 cj1;
+ Printf.printf "response1: %s\n%s\n" r1 rj1;
Printf.printf "response2: %s\n" r2;
+ Printf.printf "response3: %s\n" rj3;
let c1' = Xmlrpc.call_of_string c1 in
let r1' = Xmlrpc.response_of_string r1 in
let r2' = Xmlrpc.response_of_string r2 in
- Printf.printf "\nSanity check:\ncall=c1': %b\nresponse1=r1': %b\nresponse2=r2': %b\n"
- (call = c1') (response1 = r1') (response2 = r2')
+
+ Printf.printf "\nSanity check 2:\ncall=c1': %b\nresponse1=r1': %b\nresponse2=r2': %b\n"
+ (call = c1') (response1 = r1') (response2 = r2');
+
+ let _, cj1' = Jsonrpc.call_of_string cj1 in
+ let _, rj1' = Jsonrpc.response_of_string rj1 in
+ let _, rj3' = Jsonrpc.response_of_string rj3 in
+
+ Printf.printf "\nSanity check 3:\ncall=cj1': %b\nresponse1=rj1': %b\nresponse3=rj3': %b\n"
+ (call = cj1') (response1 = rj1') (response3 = rj3');
* GNU Lesser General Public License for more details.
*)
+open Rpc
+
let rec list_iter_between f o = function
| [] -> ()
| [h] -> f h
to_buffer t buf;
Buffer.contents buf
-
+let new_id =
+ let count = ref 0L in
+ (fun () -> count := Int64.add 1L !count; !count)
+
+let string_of_call call =
+ let json = `Dict [
+ "method", `String call.name;
+ "params", `List call.params;
+ "id", `Int (new_id ());
+ ] in
+ to_string json
+
+let string_of_response id response =
+ let json = match response with
+ | Success v ->
+ `Dict [
+ "result", v;
+ "error", `None;
+ "id", `Int id
+ ]
+ | Fault f ->
+ `Dict [
+ "result", `None;
+ "error", f;
+ "id", `Int id
+ ] in
+ to_string json
type error =
| Unexpected_char of int * char * (* json type *) string
| Expect_object_elem_colon
| Expect_comma_or_end
| Expect_object_key
- | Done of Rpc.Val.t
+ | Done of Val.t
type int_value =
- | IObject of (string * Rpc.Val.t) list
- | IObject_needs_key of (string * Rpc.Val.t) list
- | IObject_needs_value of (string * Rpc.Val.t) list * string
- | IArray of Rpc.Val.t list
+ | IObject of (string * Val.t) list
+ | IObject_needs_key of (string * Val.t) list
+ | IObject_needs_value of (string * Val.t) list * string
+ | IArray of Val.t list
type parse_state = {
mutable cursor: cursor;
| Done _ -> raise_internal_error s "parse called when parse_state is 'Done'"
type parse_result =
- | Json_value of Rpc.Val.t * (* number of consumed bytes *) int
+ | Json_value of Val.t * (* number of consumed bytes *) int
| Json_parse_incomplete of parse_state
let parse_substring state str ofs len =
end
let of_string = Parser.of_string
+
+exception Malformed_method_request of string
+exception Malformed_method_response of string
+
+let get name dict =
+ if List.mem_assoc name dict then
+ List.assoc name dict
+ else begin
+ Printf.eprintf "%s was not found in the dictionnary\n" name;
+ let str = List.map (fun (n,_) -> Printf.sprintf "%s=..." n) dict in
+ let str = Printf.sprintf "{%s}" (String.concat "," str) in
+ raise (Malformed_method_request str)
+ end
+
+let call_of_string str =
+ match of_string str with
+ | `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 }
+ | _ -> raise (Malformed_method_request str)
+
+let response_of_string str =
+ match of_string str with
+ | `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
+ begin match result, error with
+ | `None, `None -> raise (Malformed_method_response str)
+ | `None, v -> id, Fault v
+ | v, `None -> id, Success v
+ | _ -> raise (Malformed_method_response str)
+ end
+ | _ -> raise (Malformed_method_response str)
+
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 string_of_response: int64 -> Rpc.Val.t Rpc.response -> string
+val response_of_string: string -> int64 * Rpc.Val.t Rpc.response
+
+
+
params: Val.t list
}
-type response =
+type 'a response =
| Success of Val.t
- | Fault of int64 * string
+ | Fault of 'a
List.rev !r
end
-let of_string ?callback str : Rpc.Val.t =
+let of_string ?callback str =
let input = Xmlm.make_input (`String (0, str)) in
begin match Xmlm.peek input with
| `Dtd _ -> ignore (Xmlm.input input)
| _ -> () end;
Parser.of_xml ?callback [] input
-let call_of_string ?callback str : Rpc.call =
+let call_of_string ?callback str =
let input = Xmlm.make_input (`String (0, str)) in
begin match Xmlm.peek input with
| `Dtd _ -> ignore (Xmlm.input input)
) input;
{ Rpc.name = !name; Rpc.params = !params }
-let response_of_string ?callback str : Rpc.response =
+let response_of_string ?callback str =
let input = Xmlm.make_input (`String (0, str)) in
begin match Xmlm.peek input with
| `Dtd _ -> ignore (Xmlm.input input)
val string_of_call: Rpc.call -> string
val call_of_string: ?callback:Rpc.callback -> string -> Rpc.call
-val string_of_response: Rpc.response -> string
-val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response
+val string_of_response: (int64 * string) Rpc.response -> string
+val response_of_string: ?callback:Rpc.callback -> string -> (int64 * string) Rpc.response
projects / xcp / xen-api-libs.git / commitdiff