[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-API] [PATCH] [rpc-light] add {call, response}_of_string and string_of_{call, response} for JSON as well.



# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
[rpc-light] add {call,response}_of_string and string_of_{call,response} for 
JSON as well.

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

diff -r d85f31ed63ae rpc-light/examples/all_types.ml
--- a/rpc-light/examples/all_types.ml   Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/examples/all_types.ml   Fri Dec 11 17:42:43 2009 +0000
@@ -55,22 +55,36 @@
        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');
diff -r d85f31ed63ae rpc-light/jsonrpc.ml
--- a/rpc-light/jsonrpc.ml      Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/jsonrpc.ml      Fri Dec 11 17:42:43 2009 +0000
@@ -11,6 +11,8 @@
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
  *)
+
+open Rpc
 
 let rec list_iter_between f o = function
        | []   -> ()
@@ -64,7 +66,33 @@
        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
@@ -94,13 +122,13 @@
                | 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;
@@ -404,7 +432,7 @@
                | 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 =
@@ -454,3 +482,40 @@
 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)
+
diff -r d85f31ed63ae rpc-light/jsonrpc.mli
--- a/rpc-light/jsonrpc.mli     Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/jsonrpc.mli     Fri Dec 11 17:42:43 2009 +0000
@@ -14,3 +14,12 @@
 
 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
+
+
+
diff -r d85f31ed63ae rpc-light/rpc.ml
--- a/rpc-light/rpc.ml  Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/rpc.ml  Fri Dec 11 17:42:43 2009 +0000
@@ -49,6 +49,6 @@
        params: Val.t list
 }
 
-type response =
+type 'a response =
        | Success of Val.t
-       | Fault of int64 * string
+       | Fault of 'a
diff -r d85f31ed63ae rpc-light/xmlrpc.ml
--- a/rpc-light/xmlrpc.ml       Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/xmlrpc.ml       Fri Dec 11 17:42:43 2009 +0000
@@ -264,14 +264,14 @@
                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)
@@ -288,7 +288,7 @@
                ) 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)
diff -r d85f31ed63ae rpc-light/xmlrpc.mli
--- a/rpc-light/xmlrpc.mli      Fri Dec 11 16:51:24 2009 +0000
+++ b/rpc-light/xmlrpc.mli      Fri Dec 11 17:42:43 2009 +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: 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

Attachment: xapi-libs-rpc-light-call-and-response-for-JSON
Description: Text document

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

 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.