[xenvm] Improve dbus dispatch loop

diff --git a/xenvm/xenvm.ml b/xenvm/xenvm.ml
index d4390147f9761c4145faa089dfc52ab55dff4e77..cc26a97e3e3d50937f08dda8f95c28504c9e67e5 100644 (file)
--- 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;
        ()