# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
# Date 1262958466 0
# Node ID d5d9e4087939172d9af48f03c0bb98ba99127f32
# Parent 9b6f70f647a5f668f348143f1c3a19a13d8b85e8
[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@xxxxxxxxxx>
diff -r 9b6f70f647a5 -r d5d9e4087939 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
@@ -3,7 +3,7 @@
OCAMLFLAGS = -annot -g
PACKS = rpc-light
-EXAMPLES = all_types phantom
+EXAMPLES = all_types phantom xapi
EXECS=$(foreach example, $(EXAMPLES), $(example).opt)
diff -r 9b6f70f647a5 -r d5d9e4087939 rpc-light/examples/xapi.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/rpc-light/examples/xapi.ml Fri Jan 08 13:47:46 2010 +0000
@@ -0,0 +1,78 @@
+let sm =
+"<?xml version='1.0'?>
+<methodResponse>
+<params>
+<param>
+<value><struct>
+<member>
+<name>required_api_version</name>
+<value><string>1.0</string></value>
+</member>
+<member>
+<name>vendor</name>
+<value><string>Citrix Systems Inc</string></value>
+</member>
+<member>
+<name>name</name>
+<value><string>Local EXT3 VHD</string></value>
+</member>
+<member>
+<name>copyright</name>
+<value><string>(C) 2008 Citrix Systems Inc</string></value>
+</member>
+<member>
+<name>capabilities</name>
+<value><array><data>
+<value><string>SR_PROBE</string></value>
+<value><string>SR_UPDATE</string></value>
+<value><string>VDI_CREATE</string></value>
+<value><string>VDI_DELETE</string></value>
+<value><string>VDI_ATTACH</string></value>
+<value><string>VDI_DETACH</string></value>
+<value><string>VDI_UPDATE</string></value>
+<value><string>VDI_CLONE</string></value>
+<value><string>VDI_SNAPSHOT</string></value>
+<value><string>VDI_RESIZE</string></value>
+<value><string>VDI_RESIZE_ONLINE</string></value>
+</data></array></value>
+</member>
+<member>
+<name>driver_version</name>
+<value><string>1.0</string></value>
+</member>
+<member>
+<name>configuration</name>
+<value><array><data>
+<value><struct>
+<member>
+<name>description</name>
+<value><string>local device path (required) (e.g. /dev/sda3)</string></value>
+</member>
+<member>
+<name>key</name>
+<value><string>device</string></value>
+</member>
+</struct></value>
+</data></array></value>
+</member>
+<member>
+<name>description</name>
+<value><string>SR plugin which represents disks as VHD files stored on a local
EXT3 filesystem, created inside an LVM volume</string></value>
+</member>
+</struct></value>
+</param>
+</params>
+</methodResponse>
+"
+
+let empty = "<value></value>"
+
+let _ =
+ Printf.printf "Parsing SM XML ... %!";
+ Xmlrpc.response_of_string sm;
+
+ Printf.printf "OK\nParsing empty tags ... %!";
+ Xmlrpc.of_string empty;
+
+ Printf.printf "OK\n%!"
+
diff -r 9b6f70f647a5 -r d5d9e4087939 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
@@ -157,39 +157,58 @@
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,18 +223,36 @@
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 =
@@ -236,10 +273,10 @@
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 @@
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 @@
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;
3 files changed, 147 insertions(+), 28 deletions(-)
rpc-light/examples/Makefile | 2
rpc-light/examples/xapi.ml | 78 +++++++++++++++++++++++++++++++++++
rpc-light/xmlrpc.ml | 95 ++++++++++++++++++++++++++++++-------------
xen-api-libs.hg-17.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home