[Xen-API] [PATCH 08 of 17] [rpc-light] Add a function to marshal and unmarshal XMLRPC to a bigbuffer

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 67078f88291e9970dc3ca0c43ae3ba28c8c20a0a
# Parent  90fd186e17ef6bc1193681c157a6fa683be7b668
[rpc-light] Add a function to marshal and unmarshal XMLRPC to a bigbuffer

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

diff -r 90fd186e17ef -r 67078f88291e 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
@@ -77,6 +77,11 @@
        add_value (Buffer.add_string buf) x;
        Buffer.contents buf
 
+let to_a ~empty ~append x =
+       let buf = empty () in
+       add_value (fun s -> append buf s) x;
+       buf
+
 let string_of_call call =
        let module B = Buffer in
        let buf = B.create 1024 in
@@ -102,6 +107,15 @@
        add (to_string v);
        add "</param></params></methodResponse>";
        B.contents buf
+
+let a_of_response ~empty ~append response =
+       let buf = empty () in
+       let add s = append buf s in
+       let v = if response.success then response.contents else Dict [ 
"failure", response.contents ] in
+       add "<?xml version=\"1.0\"?><methodResponse><params><param>";
+       add (to_string v);
+       add "</param></params></methodResponse>";
+       buf
 
 exception Parse_error of string * Xmlm.signal * Xmlm.input
 
@@ -141,8 +155,10 @@
        aux [];
        Buffer.contents buf
 
+let pretty_string_of_error (n,s,i) =
+       Printf.sprintf "Error: got '%s' while '%s' was expected when processing 
'%s'\n" (debug_signal s) n (debug_input i)
+
 let parse_error n s i =
-       Printf.eprintf "Error: got '%s' while '%s' was expected when processing 
'%s'\n" (debug_signal s) n (debug_input i);
        raise (Parse_error (n,s,i))
 
 module Parser = struct
@@ -153,9 +169,13 @@
                | `Data d -> d
                | e       -> parse_error "..." e input
 
-       let open_tag input =
+       let rec open_tag input =
                match Xmlm.input input with
                | `El_start ((_,tag),_) -> tag
+               | `Data s
+                       when s = " " 
+                       || s = "\n" 
+                       || s = "\t"         -> open_tag input
                | e                     -> parse_error "<...>" e input
 
        let close_tag input =
@@ -241,7 +261,16 @@
        | `Dtd _ -> ignore (Xmlm.input input)
        | _      -> () end;
        Parser.of_xml ?callback [] input
-       
+
+let of_a ?callback ~next_char b =
+       let aux () =
+               try 
+                       let c = next_char b in
+                       int_of_char c
+               with _ -> raise End_of_file in
+       let input = Xmlm.make_input (`Fun aux) in
+       Parser.of_xml ?callback [] input
+
 let call_of_string ?callback str =
        let input = Xmlm.make_input (`String (0, str)) in
        begin match Xmlm.peek input with
diff -r 90fd186e17ef -r 67078f88291e 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
@@ -15,10 +15,14 @@
 val to_string : Rpc.t -> string
 val of_string : ?callback:Rpc.callback -> string -> Rpc.t
 
+val to_a : empty:(unit -> 'a) -> append:('a -> string -> unit) -> Rpc.t -> 'a
+val of_a : ?callback:Rpc.callback -> next_char:('a  -> char) -> 'a -> Rpc.t
+
 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 a_of_response : empty:(unit -> 'a) -> append:('a -> string -> unit) -> 
Rpc.response -> 'a
 
 val response_of_string: ?callback:Rpc.callback -> string -> Rpc.response
 val response_of_in_channel: ?callback:Rpc.callback -> in_channel -> 
Rpc.response
2 files changed, 36 insertions(+), 3 deletions(-)
rpc-light/xmlrpc.ml  |   35 ++++++++++++++++++++++++++++++++---
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