add a caching ability for dbus connection.

dbus bus is not reopen at each notification

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index ba54cd5236be1b2f8f3fe47dc1eea722282dcb00..fd307746dda8cce4abd958fb66b2a5f09e0b94c0 100644 (file)
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -55,12 +55,19 @@ let _notify state code l =
                connect_and_send addr fd
        | NotifyTcp6 _ ->
                ()
-       | NotifyDBus (use_session, path) ->
+       | NotifyDBus (use_session, path, cachedconn) ->
                (* path/intf/method arbitrary for now. *)
                let dbus_path = sprintf "/org/xen/vm/%s" (String.replace "-" "_" state.vm_uuid) in
                let dbus_intf = "xenvm.signal.notify" in
                let dbus_meth = "notify" in
-               let bus = DBus.Bus.get (if use_session then DBus.Bus.Session else DBus.Bus.System) in
+               let bus =
+                       match !cachedconn with
+                       | None ->
+                               let bus = DBus.Bus.get (if use_session then DBus.Bus.Session else DBus.Bus.System) in
+                               cachedconn := Some bus;
+                               bus
+                       | Some bus -> bus
+                       in
                let msg = DBus.Message.new_signal dbus_path dbus_intf dbus_meth in
                DBus.Message.append msg [ (DBus.String state.vm_uuid);
                                          (DBus.Int32 (Int32.of_int code));

diff --git a/xenvm/vmconfig.ml b/xenvm/vmconfig.ml
index fedf007e571357345ebf562cdfe73aff73fe0fdc..9a21c61f072ecdd96337533d727ff3e50ff70147 100644 (file)
--- a/xenvm/vmconfig.ml
+++ b/xenvm/vmconfig.ml
@@ -24,7 +24,7 @@ type notify_ty =
        | NotifyTcp6 of string
        | NotifyTcp of Unix.inet_addr * int
        | NotifyUnix of string
-       | NotifyDBus of bool * string option
+       | NotifyDBus of bool * string option * (DBus.bus option ref)
        | NotifyNone
 
 let string_of_notify ty =
@@ -32,7 +32,7 @@ let string_of_notify ty =
        | NotifyTcp6 s            -> sprintf "tcp6,%s" s
        | NotifyTcp (iaddr, port) -> sprintf "tcp,%s:%d" "" port
        | NotifyUnix path         -> sprintf "unix,%s" path
-       | NotifyDBus (sess, path) -> sprintf "dbus%s" (match path with None -> "" | Some path -> "," ^ path)
+       | NotifyDBus (sess, p, _) -> sprintf "dbus%s" (match p with None -> "" | Some path -> "," ^ path)
        | NotifyNone              -> ""
 
 type snapshot_mode =
@@ -301,8 +301,8 @@ let config_notify_of_string s =
                NotifyUnix path
        | "dbus" :: args -> (
                match args with
-               | []         -> NotifyDBus (false, None)
-               | path :: [] -> NotifyDBus (false, Some path)
+               | []         -> NotifyDBus (false, None, ref None)
+               | path :: [] -> NotifyDBus (false, Some path, ref None)
                | _          -> failwith "notify: bad dbus format"
                )
        | _ ->