From 5f44d41433d00feb17ac98a49f0fb7a7e1404c3b Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
Date: Wed, 12 Aug 2009 15:56:39 +0100
Subject: [PATCH] make the dbus monitor execute tasks

note: that until the queue process is done, all actions are executed
in the context of the monitor thread, so will blocks all others operations.
---
 xenvm/xenvm.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index cd4a127..f3f1625 100644
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -649,6 +649,69 @@ let monitor_rpc_json socket state =
 	)
 
 let monitor_rpc_dbus state =
+	let use_session = false in
+	let match_s = sprintf "type='method',interface='org.xen.vm.%s'" (String.replace "-" "_" state.vm_uuid) in
+	let bus = DBus.Bus.get (if use_session then DBus.Bus.Session else DBus.Bus.System) in
+	DBus.Bus.add_match bus match_s false;
+	DBus.Connection.flush bus;
+
+	let calltask msg msg_method params =
+		let xenvmlib_to_dbus rep =
+			match rep with
+			| Xenvmlib.Ok        -> Some (DBus.Message.new_method_return msg)
+			| Xenvmlib.Msg s     ->
+				let rmsg = DBus.Message.new_method_return msg in
+				DBus.Message.append rmsg [ DBus.String s ];
+				Some rmsg
+			| Xenvmlib.Error err -> Some (DBus.Message.new_error msg DBus.ERR_FAILED err)
+			| _                  -> None
+			in
+		(* if the tasks need to be threaded like start,reboot,.. we returns
+		  none to the caller and create a thread that is going to populate a queue
+		  with the return message when ready *)
+		let t = try Some (Tasks.find msg_method) with exn -> None in
+		match t with
+		| None   -> Some (DBus.Message.new_error msg DBus.ERR_SERVICE_UNKNOWN "no rpc")
+		| Some (act, task_descr) ->
+			let taskargs = List.map (fun (k, v) -> (k, Tasks.ValString v)) params in
+			if task_descr.Tasks.need_threading then (
+				thread_create (fun () ->
+					let rep = do_task state (act, taskargs) in
+					let rep = xenvmlib_to_dbus rep in
+					ignore rep (* FIXME put in the queue *)
+				) ();
+				None
+			) else
+				xenvmlib_to_dbus (do_task state (act, taskargs))
+		in
+
+	let process_message msg =
+		let params = DBus.Message.get msg in
+		match params with
+		| [ DBus.String msg_method; DBus.Array DBus.Dicts ((_, _), msg_params) ] ->
+			let params = List.map (fun (k, v) ->
+				match k, v with
+				| DBus.String key, DBus.String value -> key, value
+				| DBus.String key, DBus.Variant (DBus.String value) -> key, value
+				| _ -> assert false (* replace by sensible error *)
+			) msg_params in
+			calltask msg msg_method params
+		| _ ->
+			let err_msg = DBus.Message.new_error msg DBus.ERR_INVALID_ARGS
+			              "expecting string method followed by dictionnary" in
+			Some (err_msg)
+		in
+
+	while not state.vm_monitors.monitor_dbus_quit do
+		(* check for outputing work *)
+		DBus.Connection.read_write bus 200;
+		let reply =
+			match DBus.Connection.pop_message bus with
+			| None     -> None
+			| Some msg -> process_message msg
+			in
+		maybe (fun reply -> DBus.Connection.send bus reply; DBus.Connection.flush bus) reply
+	done;
 	()
 
 (*
-- 
2.39.5