# HG changeset patch
# User Rob Hoes <rob.hoes@xxxxxxxxxx>
# Date 1294419411 0
# Node ID 7b6fef2813f75a20b5eb877aad11e9657bc38f97
# Parent  bd7e14b4c9e36e5616530a2f14d130845edd3b07
CP-2137: Use rpc-light to implement the xapi<->v6d XMLRPC interface

Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>

diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/idl/ocaml_backend/OMakefile
--- a/ocaml/idl/ocaml_backend/OMakefile
+++ b/ocaml/idl/ocaml_backend/OMakefile
@@ -112,7 +112,7 @@
 	../../util/util_inventory \
 	../../util/version \
 	../../xapi/xapi_inventory \
-	../../license/v6xmlrpc \
+	../../license/v6rpc \
 	../../license/v6daemon \
 	$(COMMON_OBJS) \
 	$(CLIENT_OBJS)
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/OMakefile
--- a/ocaml/license/OMakefile
+++ b/ocaml/license/OMakefile
@@ -1,12 +1,12 @@
-OCAML_LIBS    = ../util/version ../idl/ocaml_backend/common ../idl/ocaml_backend/client
+OCAML_LIBS    = ../util/version ../idl/ocaml_backend/xapi_client
 OCAMLINCLUDES = ../idl/ocaml_backend ../idl ../autogen ../xapi ../gpg ../util
-OCAMLPACKS    = xml-light2 stdext stunnel http-svr log
+OCAMLPACKS    = xml-light2 stdext stunnel http-svr log rpc-light
 
-IEXE=install -m 755 -o root -g root
+UseCamlp4(rpc-light.syntax, v6rpc)
 
 V6FILES = \
 	fakev6 \
-	v6xmlrpc \
+	v6rpc \
 	v6daemon
 
 # Name of daemon to install in dom0:
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6client.ml
--- a/ocaml/license/v6client.ml
+++ b/ocaml/license/v6client.ml
@@ -12,6 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 
+open V6rpc
 module D=Debug.Debugger(struct let name="v6client" end)
 open D
 
@@ -31,7 +32,7 @@
 let socket = "/var/xapi/v6"
 
 (* RPC function for communication with the v6 daemon *)
-let v6rpc xml = Xmlrpcclient.do_xml_rpc_unix ~version:"1.0" ~filename:socket ~path:"/" xml
+let v6rpc call = Rpc_client.do_rpc_unix ~version:"1.0" ~filename:socket ~path:"/" call
 
 (* conversion to v6 edition codes *)
 let editions = [Edition.Free, "FREE"]
@@ -47,21 +48,22 @@
 	if !connected then begin
 		debug "release license";
 		try
-			let request = XMLRPC.To.methodCall "shutdown" [] in
-			let response = v6rpc request in
-			debug "response: %s" (Xml.to_string response);
-			match XMLRPC.From.methodResponse response with
-			| XMLRPC.Success [r] ->
-				let success = XMLRPC.From.boolean r in
-				debug "success: %b" success;
-				if success then begin
-					match !licensed with
+			let success =
+				let call = Rpc.call "shutdown" [] in
+				let response = v6rpc call in
+				try Rpc.bool_of_rpc response.Rpc.contents
+				with e ->
+					error "Got error %s" (Printexc.to_string e);
+					raise V6DaemonFailure in
+			debug "success: %b" success;
+			if success then begin
+				match !licensed with
 					| None -> ()
 					| Some edition ->
 						info "Checked %s license back in to license server." (Edition.to_string edition);
 						reset_state ()
 				end
-			| _ -> 
+			else
 				raise V6DaemonFailure
 		with
 		| Unix.Unix_error(a, b, c) ->
@@ -86,59 +88,48 @@
 		debug "invalid edition!"
 	else begin
 		try
-			let myassoc key args =
-				try List.assoc key args
-				with Not_found ->
-					error "key %s not found in v6d's response" key;
-					raise V6DaemonFailure
-			in
-			let get_named_string name args = XMLRPC.From.string (myassoc name args) in
-			let get_named_int name args = XMLRPC.From.int (myassoc name args) in
-			let v6_edition = List.assoc edition editions in
-			let fields = ["address", XMLRPC.To.string address; "port", XMLRPC.To.int (Int32.of_int port); "edition", XMLRPC.To.string v6_edition] in
-			let params = XMLRPC.To.structure fields in
-			let request = XMLRPC.To.methodCall "initialise" [params] in
-			let response = v6rpc request in
-			debug "response: %s" (Xml.to_string response);
-			match XMLRPC.From.methodResponse response with
-			| XMLRPC.Success [r] ->
-				let str = XMLRPC.From.structure r in
-				let license = get_named_string "license" str in
-				let days_to_expire = Int32.to_int (get_named_int "days_to_expire" str) in
-				debug "license: %s; days-to-expire: %d" license days_to_expire;
-				connected := true;
-				(* set expiry date *)
-				let now = Unix.time () in
-				if days_to_expire > -1 then
-					expires := now +. (float_of_int (days_to_expire * 24 * 3600))
+			let edition' = List.assoc edition editions in
+			let params = rpc_of_initialise_in { address = address; port = port; edition = edition' } in
+			let call = Rpc.call "initialise" [ params ] in
+			let response = v6rpc call in
+			debug "response: %s" (Rpc.to_string response.Rpc.contents);
+			let license, days_to_expire =
+				if response.Rpc.success then
+					let r = initialise_out_of_rpc response.Rpc.contents in r.license, r.days_to_expire
 				else
-					expires := never;
-				(* check fist point *)
-				(* CA-33155: FIST point may only set an expiry date earlier than the actual one *)
-				begin match Xapi_fist.set_expiry_date () with
+					raise V6DaemonFailure in
+			debug "license: %s; days-to-expire: %ld" license days_to_expire;
+			connected := true;
+			(* set expiry date *)
+			let now = Unix.time () in
+			if days_to_expire > -1l then
+				expires := now +. (Int32.to_float days_to_expire *. 24. *. 3600.)
+			else
+				expires := never;
+			(* check fist point *)
+			(* CA-33155: FIST point may only set an expiry date earlier than the actual one *)
+			begin match Xapi_fist.set_expiry_date () with
 				| None -> ()
 				| Some d ->
 					let fist_date = Date.to_float (Date.of_string d) in
 					if fist_date < !expires then expires := fist_date
-				end;
-				(* check return status *)
-				if license = "real" then begin
-					info "Checked out %s license from license server." (Edition.to_string edition);
-					licensed := Some edition;
-					grace := false
-				end else if license = "grace" then begin
-					info "Obtained %s grace license." (Edition.to_string edition);
-					licensed := Some edition;
-					grace := true;
-					if Xapi_fist.reduce_grace_period () then
-						expires := now +. (15. *. 60.)
-				end else begin
-					info "License check out failed.";
-					licensed := None;
-					grace := false
-				end
-			| _ -> 
-				raise V6DaemonFailure
+			end;
+			(* check return status *)
+			if license = "real" then begin
+				info "Checked out %s license from license server." (Edition.to_string edition);
+				licensed := Some edition;
+				grace := false
+			end else if license = "grace" then begin
+				info "Obtained %s grace license." (Edition.to_string edition);
+				licensed := Some edition;
+				grace := true;
+				if Xapi_fist.reduce_grace_period () then
+					expires := now +. (15. *. 60.)
+			end else begin
+				info "License check out failed.";
+				licensed := None;
+				grace := false
+			end
 		with
 		| Unix.Unix_error(a, b, c) ->
 			error "Problem while initialising (%s): %s" b (Unix.error_message a);
@@ -152,8 +143,8 @@
 	try
 		let ls = Db.Host.get_license_server ~__context ~self:host in
 		let address = List.assoc "address" ls in
-		let port = int_of_string (List.assoc "port" ls) in
-		debug "obtaining %s v6 license; license server address: %s; port: %d" (Edition.to_string edition) address port;
+		let port = Int32.of_string (List.assoc "port" ls) in
+		debug "obtaining %s v6 license; license server address: %s; port: %ld" (Edition.to_string edition) address port;
 		(* obtain v6 license *)
 		connect_and_get_license edition address port
 	with
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6daemon.ml
--- a/ocaml/license/v6daemon.ml
+++ b/ocaml/license/v6daemon.ml
@@ -30,9 +30,9 @@
 	let body = Http_svr.read_body req bio in
 	debug "Request: %s" body;
 	let s = Buf_io.fd_of bio in
-	let xml = Xml.parse_string body in
-	let result = process xml in
-	let str = Xml.to_string result in
+	let rpc = Xmlrpc.call_of_string body in
+	let result = process rpc in
+	let str = Xmlrpc.string_of_response result in
 	debug "Response: %s" str;
 	Http_svr.response_str req s str
 	
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6daemon.mli
--- a/ocaml/license/v6daemon.mli
+++ b/ocaml/license/v6daemon.mli
@@ -15,4 +15,4 @@
 (** Licensing daemon creation module *)
 
 (** Create and start up the licensing daemon *)
-val startup : (unit -> 'a) -> (Xml.xml -> Xml.xml) -> unit
+val startup : (unit -> 'a) -> (Rpc.call -> Rpc.response) -> unit
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6rpc.ml
--- /dev/null
+++ b/ocaml/license/v6rpc.ml
@@ -0,0 +1,65 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module D = Debug.Debugger(struct let name="v6xmlrpc" end)
+open D
+
+exception Unmarshalling_error of string
+
+type initialise_in = {
+	address: string;
+	port: int32;
+	edition: string;
+} with rpc
+
+type initialise_out = {
+	license: string;
+	days_to_expire: int32;
+} with rpc
+
+type failure = string * (string list) with rpc
+let response_of_failure code params =
+	Rpc.failure (rpc_of_failure (code, params))
+let response_of_fault code =
+	Rpc.failure (rpc_of_failure ("Fault", [code]))
+
+module type V6api = sig
+	val initialise : string -> int32 -> string -> string * int32
+	val shutdown : unit -> bool
+	val reopen_logs : unit -> bool
+end
+
+module V6process = functor(V: V6api) -> struct
+	let process call =
+		let response =
+			try match call.Rpc.name with
+			| "initialise" -> 
+				let arg_rpc = match call.Rpc.params with [a] -> a | _ -> raise (Unmarshalling_error "initialise") in
+				let arg = initialise_in_of_rpc arg_rpc in
+				let l,d = V.initialise arg.address arg.port arg.edition in
+				let response = rpc_of_initialise_out { license = l; days_to_expire = d } in 
+				Rpc.success response
+			| "shutdown" ->
+				let response = Rpc.rpc_of_bool (V.shutdown ()) in
+				Rpc.success response
+			| "reopen-logs" ->
+				let response = Rpc.rpc_of_bool (V.reopen_logs ()) in
+				Rpc.success response
+			| x -> response_of_fault ("unknown RPC: " ^ x)
+			with e ->
+				log_backtrace ();
+				response_of_failure "INTERNAL_ERROR" [Printexc.to_string e] in
+		response
+end
+
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6rpc.mli
--- /dev/null
+++ b/ocaml/license/v6rpc.mli
@@ -0,0 +1,47 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** XML/RPC handler for the licensing daemon *)
+
+(** The XML/RPC interface of the licensing daemon *)
+module type V6api =
+	sig
+		val initialise : string -> int32 -> string -> string * int32
+		val shutdown : unit -> bool
+		val reopen_logs : unit -> bool
+	end
+  
+(** XML/RPC handler *)
+module V6process : functor (V : V6api) ->
+	sig
+		(** Process an XML/RPC call *)
+		val process : Rpc.call -> Rpc.response
+	end
+
+(** {2 Marshaling functions} *)
+
+type initialise_in = {
+	address: string;
+	port: int32;
+	edition: string;
+}
+
+val rpc_of_initialise_in : initialise_in -> Rpc.t
+
+type initialise_out = {
+	license: string;
+	days_to_expire: int32;
+}
+
+val initialise_out_of_rpc : Rpc.t -> initialise_out
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6testd.ml
--- a/ocaml/license/v6testd.ml
+++ b/ocaml/license/v6testd.ml
@@ -12,7 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 
-module P = V6xmlrpc.V6process(Fakev6)
+module P = V6rpc.V6process(Fakev6)
 
 let _ =
 	Logs.reset_all [ "file:/var/log/v6d.log" ];
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6testd.mli
--- a/ocaml/license/v6testd.mli
+++ b/ocaml/license/v6testd.mli
@@ -17,5 +17,5 @@
 (** Instatiate licensing daemon XML/RPC handler *)
 module P : sig 
 	(** Process an XML/RPC call *)
-	val process : XMLRPC.xmlrpc -> XMLRPC.xmlrpc
+	val process : Rpc.call -> Rpc.response
 end
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6xmlrpc.ml
--- a/ocaml/license/v6xmlrpc.ml
+++ /dev/null
@@ -1,62 +0,0 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *)
-
-module D = Debug.Debugger(struct let name="v6xmlrpc" end)
-open D
-
-exception Unmarshalling_error of string
-
-module type V6api = sig
-	val initialise : string -> int32 -> string -> string * int32
-	val shutdown : unit -> bool
-	val reopen_logs : unit -> bool
-end
-
-module V6process = functor(V: V6api) -> struct
-	let myassoc key args =
-		try List.assoc key args with Not_found -> raise (Unmarshalling_error key)
-
-	let get_named_string name args =
-		XMLRPC.From.string (myassoc name args)
-	
-	let get_named_int name args =
-		XMLRPC.From.int (myassoc name args)
-
-	let process xml =
-		let call,args = XMLRPC.From.methodCall xml in
-		let args = try XMLRPC.From.structure (List.hd args) with _ -> [] in
-		let response = 
-			try match call with
-			| "initialise" -> 
-				let address = get_named_string "address" args in
-				let port = get_named_int "port" args in
-				let edition = get_named_string "edition" args in
-				let response = match (V.initialise address port edition) with
-				| l, d -> XMLRPC.To.structure 
-					["license", XMLRPC.To.string l; "days_to_expire", XMLRPC.To.int d] in
-				XMLRPC.Success [response]
-			| "shutdown" ->
-				let response = XMLRPC.To.boolean (V.shutdown ()) in
-				XMLRPC.Success [response]
-			| "reopen-logs" ->
-				let response = XMLRPC.To.boolean (V.reopen_logs ()) in
-				XMLRPC.Success [response]
-			| x -> XMLRPC.Fault (Int32.of_int 0, "unknown RPC: " ^ x)
-			with e ->
-				log_backtrace ();
-				XMLRPC.Failure ("INTERNAL_ERROR",[Printexc.to_string e])
-		in
-		XMLRPC.To.methodResponse response
-end
-
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/license/v6xmlrpc.mli
--- a/ocaml/license/v6xmlrpc.mli
+++ /dev/null
@@ -1,30 +0,0 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU Lesser General Public License for more details.
- *)
-
-(** XML/RPC handler for the licensing daemon *)
-
-(** The XML/RPC interface of the licensing daemon *)
-module type V6api =
-	sig
-		val initialise : string -> int32 -> string -> string * int32
-		val shutdown : unit -> bool
-		val reopen_logs : unit -> bool
-	end
-  
-(** XML/RPC handler *)
-module V6process : functor (V : V6api) ->
-	sig
-		(** Process an XML/RPC call *)
-		val process : XMLRPC.xmlrpc -> XMLRPC.xmlrpc
-	end
diff -r bd7e14b4c9e3 -r 7b6fef2813f7 ocaml/xapi/OMakefile
--- a/ocaml/xapi/OMakefile
+++ b/ocaml/xapi/OMakefile
@@ -234,6 +234,7 @@
 	../database/db_hiupgrade \
 	certificates \
 	../license/v6client \
+	../license/v6rpc \
 	bios_strings \
 	xapi_config \
 	../license/grace_retry \