add a way to specify to use session dbus for testing purpose

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index 30a30572ed9dbe4f32fcd406e9ddcfa143e607e8..ba54cd5236be1b2f8f3fe47dc1eea722282dcb00 100644 (file)
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -55,12 +55,12 @@ let _notify state code l =
                connect_and_send addr fd
        | NotifyTcp6 _ ->
                ()
-       | NotifyDBus path ->
+       | NotifyDBus (use_session, path) ->
                (* 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 DBus.Bus.System in
+               let bus = DBus.Bus.get (if use_session then DBus.Bus.Session else DBus.Bus.System) 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 e4bf8602df15274a0d170caf709472d10d81ea67..fedf007e571357345ebf562cdfe73aff73fe0fdc 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 string option
+       | NotifyDBus of bool * string option
        | 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 path         -> sprintf "dbus%s" (match path with None -> "" | Some path -> "," ^ path)
+       | NotifyDBus (sess, path) -> sprintf "dbus%s" (match path 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 (None)
-               | path :: [] -> NotifyDBus (Some path)
+               | []         -> NotifyDBus (false, None)
+               | path :: [] -> NotifyDBus (false, Some path)
                | _          -> failwith "notify: bad dbus format"
                )
        | _ ->