[Xen-API] [PATCH 13 of 17] [rpc-light] XMLRPC fault need to be parsed correctly

[Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>]

# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID 908be71d7e00c6ebedb89a674276686cd62ec433
# Parent  009c14391cf870a2a283973727c7b839250b813e
[rpc-light] XMLRPC fault need to be parsed correctly

Moreover, in case of complex return value v when we have an error, apply the 
xapi policy which is to create a structure { Status : Failure; ErrorDescription 
: v }. When unmarshalling the XMLRPC, if we got { Status : Success; Value: v }, 
then it is equivalent to v. This is sufficiently flexible to discuss with the 
SM backend and xapi (which have different conventions).

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

diff -r 009c14391cf8 -r 908be71d7e00 rpc-light/examples/Makefile
--- a/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/examples/Makefile       Fri Jan 08 13:47:46 2010 +0000
@@ -7,7 +7,8 @@
        all_types \
        phantom \
        xapi \
-       option
+       option \
+       encoding
 
 EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
 
diff -r 009c14391cf8 -r 908be71d7e00 rpc-light/examples/encoding.ml
--- /dev/null   Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/examples/encoding.ml    Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,11 @@
+type t = string with rpc
+
+let _ =
+       let t = "<provision><value><int>4</int></value>" in
+       let r = rpc_of_t t in
+       Printf.printf "r = %s\n%!" (Rpc.to_string r);
+
+       let t' = t_of_rpc r in
+       Printf.printf "t = t : %b'\n%!" (t = t');
+       assert (t = t')
+
diff -r 009c14391cf8 -r 908be71d7e00 rpc-light/examples/xapi.ml
--- a/rpc-light/examples/xapi.ml        Fri Jan 08 13:47:46 2010 +0000
+++ b/rpc-light/examples/xapi.ml        Fri Jan 08 13:47:46 2010 +0000
@@ -1,3 +1,37 @@
+let simple_call =
+"<methodCall>
+  <methodName>session.login_with_password</methodName>
+  <params>
+    <param>
+      <value/>
+    </param>
+    <param>
+      <value/>
+    </param>
+    <param>
+      <value>1.4</value>
+    </param>
+  </params>
+</methodCall>
+"
+
+let error = 
+"<methodResponse>
+<fault>
+<value><struct>
+<member>
+<name>faultCode</name>
+<value><int>143</int></value>
+</member>
+<member>
+<name>faultString</name>
+<value><string>Failed to parse the request</string></value>
+</member>
+</struct></value>
+</fault>
+</methodResponse>
+"
+
 let sm =
 "<?xml version='1.0'?>
 <methodResponse>
@@ -74,5 +108,11 @@
        Printf.printf "OK\nParsing empty tags ... %!";
        Xmlrpc.of_string empty;
 
+       Printf.printf "OK\nParsing error ... %!";
+       Xmlrpc.response_of_string error;
+
+       Printf.printf "OK\nParsing simple call ... %!";
+       Xmlrpc.call_of_string simple_call;
+
        Printf.printf "OK\n%!"
 
diff -r 009c14391cf8 -r 908be71d7e00 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
@@ -98,23 +98,26 @@
        add "</params></methodCall>";
        B.contents buf
 
+let add_response add response =
+       let v = if response.success then
+               Dict [ "Status", String "Success"; "Value", response.contents ]
+       else
+               Dict [ "Status", String "Failure"; "ErrorDescription", 
response.contents ] in
+       add "<?xml version=\"1.0\"?><methodResponse><params><param>";
+       add (to_string v);
+       add "</param></params></methodResponse>"
+
 let string_of_response response =
        let module B = Buffer in
        let buf = B.create 256 in
        let add = B.add_string buf 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>";
+       add_response add response;
        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>";
+       add_response add response;
        buf
 
 exception Parse_error of string * string * Xmlm.input
@@ -219,7 +222,7 @@
                        close_tag tag input;
                        r
                end else
-                       parse_error (sprintf "open_tag(%s)" t) (sprintf 
"open_tag(%s)" t) input
+                       parse_error (sprintf "open_tag(%s)" t) (sprintf 
"open_tag(%s)" tag) input
 
        let name   input   = map_tag "name" get_data input
        let data   f input = map_tag "data" f input
@@ -283,13 +286,13 @@
        and basic_types ?callback accu input = function
                | "int"
                | "i4"     -> make_int    ?callback accu (get_data input)
-               | "boolean"   -> make_bool   ?callback accu (get_data input)
+               | "boolean"-> make_bool   ?callback accu (get_data input)
                | "double" -> make_float  ?callback accu (get_data input)
                | "string" -> make_string ?callback accu (get_data input)
                | "array"  -> make_enum   ?callback accu (data (of_xmls 
?callback accu) input)
                | "struct" -> make_dict   ?callback accu (members (fun name -> 
of_xml ?callback (name::accu)) input)
                | "nil"    -> make_null   ?callback accu ()
-               | tag      -> parse_error (sprintf "open_tag(%s)" tag) 
"open_tag(int/i4/bool/double/string/array/struct/nil" input
+               | tag      -> parse_error (sprintf "open_tag(%s)" tag) 
"open_tag(int/i4/boolean/double/string/array/struct/nil)" input
 
        and of_xmls ?callback accu input =
                let r = ref [] in
@@ -333,21 +336,47 @@
                                Parser.skip_empty input;
                        done;
                        ) input
-               ) input;
+               ) input; 
        call !name (List.rev !params)
-       
+
+let response_of_fault ?callback input =
+       Parser.map_tag "fault" (fun input ->
+               match Parser.of_xml ?callback [] input with
+               | Dict d ->
+                       let fault_code = List.assoc "faultCode" d in 
+                       let fault_string = List.assoc "faultString" d in
+                       failure ( Rpc.Enum [ String "fault"; fault_code; 
fault_string ] )
+               | r      -> parse_error (to_string r) "fault" input
+               ) input
+
+let response_of_success ?callback input =
+       Parser.map_tag "params" (fun input ->
+               Parser.map_tag "param" (fun input ->
+                       match Parser.of_xml ?callback [] input with
+                       | Dict d ->
+                               if List.mem_assoc "Status" d && List.assoc 
"Status" d = String "Success" && List.mem_assoc "Value" d then
+                                       success (List.assoc "Value" d)
+                               else if List.mem_assoc "Status" d && List.assoc 
"Status" d = String "Failure" && List.mem_assoc "ErrorDescription" d then
+                                       failure (List.assoc "ErrorDescription" 
d)
+                               else
+                                       success (Dict d)
+                       | v  -> success v
+                       ) input
+               ) input
+
 let response_of_input ?callback input =
        begin match Xmlm.peek input with
        | `Dtd _ -> ignore (Xmlm.input input)
        | _      -> () end;
        Parser.map_tag "methodResponse" (fun input ->
-               Parser.map_tag "params" (fun input ->
-                       Parser.map_tag "param" (fun input ->
-                               match Parser.of_xml ?callback [] input with
-                               | Dict [ "failure", v ] -> failure v
-                               | v                     -> success v
-                               ) input
-                       ) input
+               Parser.skip_empty input;
+               match Xmlm.peek input with
+               | `El_start ((_,"params"),_) -> response_of_success ?callback 
input
+               | `El_start ((_,"fault"),_)  -> response_of_fault ?callback 
input
+               | `El_start ((_,tag),_)      -> parse_error (sprintf 
"open_tag(%s)" tag) "open_tag(fault/params)" input
+               | `Data d                    -> parse_error (String.escaped d) 
"open_tag(fault/params)" input
+               | `El_end                    -> parse_error "close_tag" 
"open_tag(fault/params)" input
+               | `Dtd _                     -> parse_error "dtd" 
"open_tag(fault/params)" input
                ) input
 
 let response_of_string ?callback str =
4 files changed, 102 insertions(+), 21 deletions(-)
rpc-light/examples/Makefile    |    3 +
rpc-light/examples/encoding.ml |   11 ++++++
rpc-light/examples/xapi.ml     |   40 +++++++++++++++++++++++
rpc-light/xmlrpc.ml            |   69 ++++++++++++++++++++++++++++------------

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