From 0cb577be58fceb880e6512fc6d24ac08675e20c7 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Mon, 11 Jan 2010 17:44:38 +0000 Subject: [PATCH] [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 --- rpc-light/examples/Makefile | 2 +- rpc-light/examples/xapi.ml | 68 ++------------------------ rpc-light/xmlrpc.ml | 95 ++++++++++++++++++++++++++----------- 3 files changed, 72 insertions(+), 93 deletions(-) diff --git a/rpc-light/examples/Makefile b/rpc-light/examples/Makefile index d5f372d..24324cd 100644 --- 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 90969c3..54f42f9 100644 --- a/rpc-light/examples/xapi.ml +++ b/rpc-light/examples/xapi.ml @@ -1,57 +1,3 @@ -let array_call = -" - event.register - - - OpaqueRef:8ecbbb2a-a905-d422-1153-fadc00639b12 - - - - - - pbd - - - - - - -" - -let simple_call = -" - session.login_with_password - - - - - - - - - 1.4 - - - -" - -let error = -" - - - -faultCode -143 - - -faultString -Failed to parse the request - - - - -" - let sm = " @@ -123,18 +69,10 @@ let empty = "" 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 29e0d3e..29ccc13 100644 --- 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; -- 2.39.5