[rpc-light] Fix-up some bugs in the XML parser code

Also add some tests to check that the library can understand what the SM backend is saying

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

diff --git a/rpc-light/examples/Makefile b/rpc-light/examples/Makefile
index d5f372daf17b0d632d6e41ae0109a2294cfdc5fa..24324cde1e1f1fdb16347cc45a31aa8d4d9d4da2 100644 (file)
--- a/rpc-light/examples/Makefile
+++ b/rpc-light/examples/Makefile
@@ -3,7 +3,7 @@ OCAMLOPT = ocamlfind ocamlopt
 OCAMLFLAGS = -annot -g
 
 PACKS = rpc-light
-EXAMPLES = all_types phantom
+EXAMPLES = all_types phantom xapi
 
 EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
 

diff --git a/rpc-light/examples/xapi.ml b/rpc-light/examples/xapi.ml
index 90969c3f2158a724ff627e35eb02955d278f8eff..54f42f94ef7665d26c37e941dbab3787720b4d34 100644 (file)
--- a/rpc-light/examples/xapi.ml
+++ b/rpc-light/examples/xapi.ml
@@ -1,57 +1,3 @@
-let array_call = 
-"<methodCall>
-  <methodName>event.register</methodName>
-  <params>
-    <param>
-      <value>OpaqueRef:8ecbbb2a-a905-d422-1153-fadc00639b12</value>
-    </param>
-    <param>
-      <value>
-        <array>
-          <data>
-            <value>pbd</value>
-          </data>
-        </array>
-      </value>
-    </param>
-  </params>
-</methodCall>
-"
-
-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>
@@ -123,18 +69,10 @@ let empty = "<value></value>"
 
 let _ =
        Printf.printf "Parsing SM XML ... %!";
-       let _ = Xmlrpc.response_of_string sm in
+       Xmlrpc.response_of_string sm;
 
        Printf.printf "OK\nParsing empty tags ... %!";
-       let _ = Xmlrpc.of_string empty in
-
-       Printf.printf "OK\nParsing error ... %!";
-       let _ = Xmlrpc.response_of_string error in
-
-       Printf.printf "OK\nParsing simple call ... %!";
-       let _ = Xmlrpc.call_of_string simple_call in
-
-       Printf.printf "OK\nParsing array call ... %!"
-       let _ = Xmlrpc.call_of_string array_call in
+       Xmlrpc.of_string empty;
 
        Printf.printf "OK\n%!"
+

diff --git a/rpc-light/xmlrpc.ml b/rpc-light/xmlrpc.ml
index 29e0d3eeccfe315d20704e86523ba5197b30ebf0..29ccc1348b4d6453ad5eac67e8a514a2679be9f3 100644 (file)
--- a/rpc-light/xmlrpc.ml
+++ b/rpc-light/xmlrpc.ml
@@ -157,39 +157,58 @@ let parse_error got expected input =
 
 module Parser = struct
 
+       let is_empty s =
+               let is_empty = ref true in
+               for i = 0 to (String.length s - 1)
+               do
+                       if s.[i] <> '\n' && s.[i] <> ' ' && s.[i] <> '\t' then is_empty := false
+               done;
+               !is_empty
+
+       let rec skip_empty input =
+               match Xmlm.peek input with
+               | `Data d when is_empty d -> let _ = Xmlm.input input in skip_empty input
+               | _                       -> ()
+
        (* Helpers *)
        let get_data input =
                match Xmlm.input input with
                | `Dtd _                -> parse_error "dtd" "data" input
                | `Data d               -> d
                | `El_start ((_,tag),_) -> parse_error (sprintf "open_tag(%s)" tag) "data" input
-               | `El_end               -> parse_error "close_tag" "data" input
+               | `El_end               -> ""
 
        let rec open_tag input =
                match Xmlm.input input with
-               | `Dtd _                -> parse_error "dtd" "open_tag" input
-               | `El_start ((_,tag),_) -> tag
-               | `Data d
-                       when d = " " 
-                       || d = "\n" 
-                       || d = "\t"         -> open_tag input
-               | `Data d               -> parse_error (sprintf "data(%s)" (String.escaped d)) "open_tag" input
-               | `El_end               -> parse_error "close_tag" "open_tag" input
+               | `Dtd _                  -> parse_error "dtd" "open_tag" input
+               | `El_start ((_,tag),_)   -> tag
+               | `Data d when is_empty d -> open_tag input
+               | `Data d                 -> parse_error (sprintf "data(%s)" (String.escaped d)) "open_tag" input
+               | `El_end                 -> parse_error "close_tag" "open_tag" input
 
        let rec close_tag tag input =
                match Xmlm.input input with
-               | `Dtd _              -> parse_error "dtd" (sprintf "close_tag(%s)" tag) input
-               | `El_end             -> ()
-               | `El_start ((_,t),_) -> parse_error (sprintf "open_tag(%s)" t) (sprintf "close_tag(%s)" tag) input
-               | `Data d
-                       when d = " "
-                       || d = "\n"
-                       || d = "\t"       -> close_tag tag input
-               | `Data d             -> parse_error (sprintf "data(%s)" (String.escaped d)) (sprintf "close_tag(%s)" tag) input
+               | `Dtd _                  -> parse_error "dtd" (sprintf "close_tag(%s)" tag) input
+               | `El_end                 -> ()
+               | `El_start ((_,t),_)     -> parse_error (sprintf "open_tag(%s)" t) (sprintf "close_tag(%s)" tag) input
+               | `Data d when is_empty d -> close_tag tag input
+               | `Data d                 -> parse_error (sprintf "data(%s)" (String.escaped d)) (sprintf "close_tag(%s)" tag) input
+
+       let empty_tag input = function
+               | "string" -> String ""
+               | "array"  -> Enum []
+               | "struct" -> Dict []
+               | "nil"    -> Null
+               | "value"  -> String ""
+               | tag      -> parse_error (sprintf "empty_%s" tag) tag input
 
        let map_tags f input =
                let tag = open_tag input in
-               let r = f input tag in
+               let r = 
+                       if Xmlm.peek input = `El_end then
+                               empty_tag input tag
+                       else
+                               f input tag in
                close_tag tag input;
                r
 
@@ -204,19 +223,37 @@ module Parser = struct
 
        let name   input   = map_tag "name" get_data input
        let data   f input = map_tag "data" f input
-       let value  f input = map_tag "value" f input
+       let value  f input =
+               let t = open_tag input in
+               if t = "value" then begin
+                       let r =
+                               match Xmlm.peek input with
+                               | `El_end -> Rpc.String ""
+                               | `Data d ->
+                                       let _ = Xmlm.input input in
+                                       if is_empty d && match Xmlm.peek input with `El_start _ -> true | _ -> false then
+                                               f input
+                                       else
+                                               Rpc.String d
+                               | _       -> f input in
+                       close_tag "value" input;
+                       r
+               end else
+                       parse_error "open_tag(value)" (sprintf "open_tag(%s)" t) input
+
        let members f input =
                let g input =
                        let name  = name input in
                        let value = f name input in
                        (name, value) in
                let r = ref [] in
+               skip_empty input;
                while Xmlm.peek input <> `El_end do
-                       r := map_tag "member" g input :: !r
+                       r := map_tag "member" g input :: !r;
+                       skip_empty input;
                done;
                List.rev !r
 
-
        (* Constructors *)
        let make fn ?callback accu data =
                let r = fn data in
@@ -236,10 +273,10 @@ module Parser = struct
        let rec of_xml ?callback accu input =
                try value (map_tags (basic_types ?callback accu)) input
                with
-               | Xmlm.Error ((a,b), e) ->
-                       eprintf "Characters %i--%i: %s\n%!" a b (Xmlm.error_message e);
-                       exit (-1)
-               | e -> eprintf "%s\n%!" (Printexc.to_string e); exit (-1)
+                       | Xmlm.Error ((a,b), e) ->
+                               eprintf "Characters %i--%i: %s\n%!" a b (Xmlm.error_message e);
+                               exit (-1)
+                       | e -> eprintf "%s\n%!" (Printexc.to_string e); exit (-1)
 
        and basic_types ?callback accu input = function
                | "int"
@@ -254,8 +291,10 @@ module Parser = struct
 
        and of_xmls ?callback accu input =
                let r = ref [] in
+               skip_empty input;
                while Xmlm.peek input <> `El_end do
-                       r := of_xml ?callback accu input :: !r
+                       r := of_xml ?callback accu input :: !r;
+                       skip_empty input;
                done;
                List.rev !r
 end
@@ -286,8 +325,10 @@ let call_of_string ?callback str =
        Parser.map_tag "methodCall" (fun input ->
                name := Parser.map_tag "methodName" Parser.get_data input;
                Parser.map_tag "params" (fun input ->
+                       Parser.skip_empty input;
                        while Xmlm.peek input <> `El_end do
-                               Parser.map_tag "param" (fun input -> params := (Parser.of_xml ?callback [] input) :: !params) input
+                               Parser.map_tag "param" (fun input -> params := (Parser.of_xml ?callback [] input) :: !params) input;
+                               Parser.skip_empty input;
                        done;
                        ) input
                ) input;