From: Tomasz Wroblewski <tomasz.wroblewski@citrix.com>
Date: Thu, 21 Jan 2010 16:29:26 +0000 (+0000)
Subject: [xenvm] Improve dbus dispatch loop
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=ca15ad60e9cc2da79f28604bbbf61b3865954731;p=xenclient%2Ftoolstack.git

[xenvm] Improve dbus dispatch loop
---

diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index d439014..cc26a97 100644
--- a/xenvm/xenvm.ml
+++ b/xenvm/xenvm.ml
@@ -855,18 +855,21 @@ let monitor_rpc_dbus state =
 			List.iter (fun out -> let (_: int32) = DBus.Connection.send bus out in ()) outmsgs;
 			DBus.Connection.flush bus
 		);
-		let still_connected = DBus.Connection.read_write_dispatch bus 200 in
+		let still_connected = DBus.Connection.read_write bus 200 in
 		ignore still_connected; (* FIXME we should probably do something more sensible here *)
-		let reply =
+		let rec drain () =
 			match DBus.Connection.pop_message bus with
-			| None     -> None
-			| Some msg -> process_message msg
-			in
-		maybe (fun reply ->
-			Mutex.execute outgoing_mutex (fun () ->
-				Queue.push reply outgoing
-			)
-		) reply
+			| None     -> ()
+			| Some msg ->
+				  let reply = process_message msg in
+				  maybe (fun reply ->
+					  Mutex.execute outgoing_mutex (fun () ->
+						  Queue.push reply outgoing
+					  ) 
+		                  ) reply;
+				  drain ()
+		in
+		drain ()
 	done;
 	notify_quit state;
 	()