Update xapi to use the shared XMLRPC library.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>

ocaml/client_records/OMakefile

@@ -1,3 +1,4 @@
+OCAMLPACKS += http-svr
 OCAMLINCLUDES += ../autogen ../idl ../idl/ocaml_backend ../database
 
 .PHONY: clean

ocaml/database/master_connection.ml

@@ -130,7 +130,7 @@ let do_db_xml_rpc_persistent_with_reopen ~host ~path (req: string) : string =
       try
 	let req_string = req in
 	(* The pool_secret is added here and checked by the Xapi_http.add_handler RBAC code. *)
-	let open Xmlrpcclient in
+	let open Xmlrpc_client in
 	let request = xmlrpc 
 		~version:"1.1" ~keep_alive:true
 		~length:(Int64.of_int (String.length req_string))

ocaml/events/event_listen.ml

@@ -20,7 +20,7 @@ let password = ref ""
 
 (* The interface to the ocaml client bindings requires a function which performs the XMLRPC call: *)
 let rpc xml =
-	let open Xmlrpcclient in
+	let open Xmlrpc_client in
 	let http = xmlrpc ~version:"1.0" "/" in
 	XML_protocol.rpc ~transport:(TCP(!host, !port)) ~http xml
 

ocaml/graph/graph.ml

@@ -125,7 +125,7 @@ let singleton = ref false
 
 (* The interface to the ocaml client bindings requires a function which performs the XMLRPC call: *)
 let rpc xml = 
-	let open Xmlrpcclient in
+	let open Xmlrpc_client in
 	XML_protocol.rpc ~transport:(TCP(!host, !port)) ~http:(xmlrpc ~version:"1.0" "/") xml
 
 let _ =

ocaml/idl/OMakefile

@@ -8,7 +8,7 @@ JQUERYTREEVIEWZIP_DISTFILE = $(CARBON_DISTFILES)/javascript/jquery/treeview/jque
 PSTOPDF = $(shell bash -c "which pstopdf 2>/dev/null || which ps2pdf 2>/dev/null || which ps2pdf14 2>/dev/null || echo false")
 
 OCAMLINCLUDES  = ocaml_backend ../database
-OCAMLPACKS     = xml-light2 sexpr log
+OCAMLPACKS     = xml-light2 sexpr log http-svr
 
 CAMLP4_FILES = datamodel_types
 
@@ -25,7 +25,7 @@ OCamlLibrary(datamodel, datamodel constants datamodel_utils datamodel_types api_
 # -----------------------------------------------------------------------
 
 DATAMODEL = datamodel
-DATAMODEL_FILES = constants datamodel_types api_errors api_messages dm_api datamodel datamodel_utils dtd_backend latex_backend dot_backend html_backend html_imagemap html_common html_main html_autogen html_types ocaml_backend/xMLRPC ocaml_backend/ref ../database/string_marshall_helper
+DATAMODEL_FILES = constants datamodel_types api_errors api_messages dm_api datamodel datamodel_utils dtd_backend latex_backend dot_backend html_backend html_imagemap html_common html_main html_autogen html_types ocaml_backend/ref ../database/string_marshall_helper
 
 SHARED_TEX = coversheet.tex presentation.tex vm-lifecycle.tex wire-protocol.tex
 SHARED_EPS = vm_lifecycle.eps

ocaml/idl/datamodel_types.ml

@@ -244,3 +244,42 @@ let rec type_checks v t =
       all_true (List.map (fun v->type_checks v t) vl)
   | VRef r, Ref _ -> true
   | _, _ -> false
+
+module TypeToXML = struct
+
+  let string x = Xml.Element(x, [], [])
+  let box tag vs = Xml.Element(tag, [], vs)
+
+  let rec marshal_ = function
+    | String         -> string "string"
+    | Int            -> string "int"
+    | Float          -> string "float"
+    | Bool           -> string "bool"
+    | DateTime       -> string "datetime"
+    | Enum (name, _) -> box "enum" [ string name ]
+    | Ref x          -> box "ref" [ string x ]
+    | Set ty         -> box "set" [ marshal_ ty ]
+    | Map (a, b)     -> box "map" [ marshal_ a; marshal_ b ]
+    | Record x       -> box "record" [ string x ]
+
+  let marshal = function
+    | None   -> string "none"
+    | Some x -> box "some" [ marshal_ x ]
+
+  let rec unmarshal_ = function
+    | Xml.Element("string", [], [])                    -> String
+    | Xml.Element("int", [], [])                       -> Int
+    | Xml.Element("float", [], [])                     -> Float
+    | Xml.Element("datetime", [], [])                  -> DateTime
+    | Xml.Element("enum", [], [Xml.Element(name, [], [])]) -> Enum(name, [])
+    | Xml.Element("ref", [],  [Xml.Element(name, [], [])]) -> Ref name
+    | Xml.Element("set", [], [t])                      -> Set(unmarshal_ t)
+    | Xml.Element("map", [], [a;b])                    -> Map(unmarshal_ a, unmarshal_ b)
+    | _ -> failwith "Type unmarshal error"
+
+  let unmarshal = function
+    | Xml.Element("none", [], [])  -> None
+    | Xml.Element("some", [], [x]) -> Some (unmarshal_ x)
+    | _ -> failwith "Type unmarshal error"
+
+end

ocaml/idl/ocaml_backend/OMakefile

@@ -14,7 +14,7 @@ OCAMLINCLUDES += .. ../.. ../../database $(AUTOGEN_DIR) ../../xapi ../../client_
 OCAMLPACKS += sexpr http-svr rpc-light
 
 # only gen_api requires datamodel library:
-GEN_API_FILES = gen_api genOCaml ref ocaml_syntax gen_db_actions gen_db_check gen_empty_custom gen_client gen_server gen_common gen_rbac ../../database/escaping xMLRPC locking ../api_lowlevel gen_api_main ../datamodel ../constants ../api_errors ../api_messages ../datamodel_utils ../datamodel_values ocaml_utils ../datamodel_types ../dm_api $(AUTOGEN_HELPER_DIR)/string_marshall_helper
+GEN_API_FILES = gen_api genOCaml ref ocaml_syntax gen_db_actions gen_db_check gen_empty_custom gen_client gen_server gen_common gen_rbac ../../database/escaping locking ../api_lowlevel gen_api_main ../datamodel ../constants ../api_errors ../api_messages ../datamodel_utils ../datamodel_values ocaml_utils ../datamodel_types ../dm_api $(AUTOGEN_HELPER_DIR)/string_marshall_helper
 OCamlProgram(gen_api_main, $(GEN_API_FILES))
 OCamlDocProgram(gen_api_main, $(GEN_API_FILES))
 
@@ -51,10 +51,10 @@ autogen_idl: $(AUTOGEN_DIR)/client.ml $(AUTOGEN_DIR)/aPI.ml $(AUTOGEN_DIR)/serve
 # -----------------------------------------------------------------------
 
 COMMON_OBJS = ref \
-	../datamodel_types xMLRPC event_types \
+	../datamodel_types event_types \
 	../api_errors ../api_messages ../../xapi/config_constants ../../xapi/xapi_globs \
 	../constants
-CLIENT_OBJS = xmlrpcclient $(AUTOGEN_DIR)/aPI $(AUTOGEN_DIR)/client event_helper
+CLIENT_OBJS = $(AUTOGEN_DIR)/aPI $(AUTOGEN_DIR)/client event_helper
 SERVER_OBJS = ../../database/escaping locking_helpers \
 	$(AUTOGEN_DIR)/server \
 	$(AUTOGEN_DIR)/db_actions $(AUTOGEN_DIR)/custom_actions \

ocaml/idl/ocaml_backend/genOCaml.ml

@@ -49,7 +49,7 @@ let ty_to_xmlrpc api ty =
     | Int -> "fun n -> To.string(Int64.to_string n)"
     | Map(key, value) ->
 	let kf = begin match key with
-	  | Ref x -> "ToString.reference"
+	  | Ref x -> "tostring_reference"
 	  | Enum (name, cs) ->
 	      let aux (c, _) = Printf.sprintf "%s -> \"%s\"" (constructor_of c) (String.lowercase c) in
 	      "   function " ^ (String.concat ("\n" ^ indent ^ "| ") (List.map aux cs))
@@ -84,6 +84,7 @@ let gen_to_xmlrpc api tys = block
 
     ["let methodCall = To.methodCall"];
     ["let methodResponse f x = To.methodResponse (f x)"; ];
+	["let tostring_reference = Ref.string_of"];
     ["let set f l =";
      "  To.array (List.map f l)"];
     ["let map fk fv m =";
@@ -115,7 +116,7 @@ let ty_of_xmlrpc api ty =
     | Int -> wrap "xml" "Int64.of_string(From.string xml)"
     | Map(key, value) ->
 	let kf = begin match key with
-	  | Ref x -> "FromString.reference"
+	  | Ref x -> "fromstring_reference"
 	  | Enum (name, cs) ->
 	      let aux (c, _) = "\""^(String.lowercase c)^"\" -> "^constructor_of c in
 	      wrap "txt"
@@ -167,6 +168,7 @@ let gen_of_xmlrpc api tys = block
   ([["open Xml"];
     ["exception Dispatcher_FieldNotFound of string"];
     ["let my_assoc fld assoc_list = try List.assoc fld assoc_list with Not_found -> raise (Dispatcher_FieldNotFound fld)"];
+	["let fromstring_reference = Ref.of_string"];
     ["let methodCall = From.methodCall"];
     ["let methodResponse = From.methodResponse"];
     ["let set f (xml: XMLRPC.xmlrpc) =";

ocaml/idl/ocaml_backend/gen_server.ml

@@ -204,7 +204,7 @@ let operation (obj: obj) (x: message) =
 
 	let gen_body () =
 		let ret = match x.msg_result with Some(ty, _) -> Some ty | _ -> None in
-		let type_xml = XMLRPC.TypeToXML.marshal ret in
+		let type_xml = Datamodel_types.TypeToXML.marshal ret in
 		let module_prefix = if (Gen_empty_custom.operation_requires_side_effect x) then _custom else _db_defaults in
 		let common_let_decs =
 			[