Merge pull request #22 from ocaml-community/xdg_fallback

Implement dbus' XDG_RUNTIME_DIR/bus fallback for session bus

src/protocol/oBus_address.ml

@@ -86,6 +86,7 @@ let to_string l =
 
 let system_bus_variable = "DBUS_SYSTEM_BUS_ADDRESS"
 let session_bus_variable = "DBUS_SESSION_BUS_ADDRESS"
+let xdg_runtime_dir_variable = "XDG_RUNTIME_DIR"
 
 let default_system = [{ name = "unix"; args = [("path", "/var/run/dbus/system_bus_socket")] }]
 let default_session = [{ name = "autolaunch"; args = [] }]
@@ -99,16 +100,38 @@ let system = lazy(
         Lwt.return default_system
 )
 
+let xdg_fallback_session () =
+  match try Some (Sys.getenv xdg_runtime_dir_variable) with | Not_found -> None with
+  | None ->
+     Lwt.return_none
+  | Some path ->
+     Lwt.catch (fun () ->
+         let sock_path = Filename.concat path "bus" in
+         let%lwt stat = Lwt_unix.stat sock_path in
+         let%lwt login = Lwt_unix.getlogin () in
+         let%lwt user = Lwt_unix.getpwnam login in
+         if stat.st_uid = user.pw_uid
+            && stat.st_kind = Lwt_unix.S_SOCK
+         then Lwt.return_some [{ name = "unix"; args = [("path", sock_path)] }]
+         else Lwt.return_none)
+       (fun _ -> Lwt.return_none)
+
 let session = lazy(
   match try Some(Sys.getenv session_bus_variable) with Not_found -> None with
     | Some line ->
         Lwt.return (of_string line)
     | None ->
-        let%lwt () = Lwt_log.info_f ~section "environment variable %s not found, trying to get session bus address from launchd" session_bus_variable in
-        try%lwt
-          let%lwt path = Lwt_process.pread_line ("launchctl", [|"launchctl"; "getenv"; "DBUS_LAUNCHD_SESSION_BUS_SOCKET"|]) in
-          Lwt.return [{ name = "unix"; args = [("path", path)] }]
-        with exn ->
-          let%lwt () = Lwt_log.info_f ~exn ~section "failed to get session bus address from launchd, using internal default" in
-          Lwt.return default_session
+        let%lwt () = Lwt_log.info_f ~section "environment variable %s not found, trying XDG_RUNTIME_DIR/bus" session_bus_variable in
+        let%lwt xdg_session = xdg_fallback_session () in
+        match xdg_session with
+        | Some session ->
+           Lwt.return session
+        | None ->
+           let%lwt () = Lwt_log.info_f ~section "failed to connect to %s/bus, trying to get session bus address from launchd" xdg_runtime_dir_variable in
+           try%lwt
+             let%lwt path = Lwt_process.pread_line ("launchctl", [|"launchctl"; "getenv"; "DBUS_LAUNCHD_SESSION_BUS_SOCKET"|]) in
+             Lwt.return [{ name = "unix"; args = [("path", path)] }]
+           with exn ->
+             let%lwt () = Lwt_log.info_f ~exn ~section "failed to get session bus address from launchd, using internal default" in
+             Lwt.return default_session
 )