1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
(*
* oBus_address.ml
* ---------------
* Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
* Licence : BSD3
*
* This file is a part of obus, an ocaml implementation of D-Bus.
*)
let section = Lwt_log.Section.make "obus(address)"
(* +-----------------------------------------------------------------+
| Types |
+-----------------------------------------------------------------+ *)
type guid = OBus_uuid.t
type t = {
name : string;
args : (string * string) list;
}
let name a = a.name
let args a = a.args
let make ~name ~args = { name = name; args = args }
let arg arg address =
OBus_util.assoc arg address.args
let guid address =
match OBus_util.assoc "guid" address.args with
| Some guid -> Some(OBus_uuid.of_string guid)
| None -> None
(* +-----------------------------------------------------------------+
| Parsing/marshaling |
+-----------------------------------------------------------------+ *)
exception Parse_failure of string * int * string
let () =
Printexc.register_printer
(function
| Parse_failure(str, pos, msg) ->
Some(Printf.sprintf "failed to parse D-Bus addresses %S, at position %d: %s" str pos msg)
| _ ->
None)
let of_string str =
try
List.map
(fun (name, args) -> { name = name; args = args })
(OBus_address_lexer.addresses (Lexing.from_string str))
with OBus_address_lexer.Fail(pos, msg) ->
raise (Parse_failure(str, pos, msg))
let to_string l =
let buf = Buffer.create 42 in
let escape = String.iter begin fun ch -> match ch with
| '0'..'9' | 'A'..'Z' | 'a'..'z'
| '_' | '-' | '/' | '.' | '\\' ->
Buffer.add_char buf ch
| _ ->
Printf.bprintf buf "%%%02x" (Char.code ch)
end in
let concat ch f = function
| [] -> ()
| x :: l -> f x; List.iter (fun x -> Buffer.add_char buf ch; f x) l
in
concat ';' begin fun { name = name; args = args } ->
Buffer.add_string buf name;
Buffer.add_char buf ':';
concat ','
(fun (k, v) ->
Buffer.add_string buf k;
Buffer.add_char buf '=';
escape v)
args
end l;
Buffer.contents buf
(* +-----------------------------------------------------------------+
| Well known addresses |
+-----------------------------------------------------------------+ *)
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 = [] }]
let system = lazy(
match try Some (Sys.getenv system_bus_variable) with Not_found -> None with
| Some str ->
Lwt.return (of_string str)
| None ->
let%lwt () = Lwt_log.info_f ~section "environment variable %s not found, using internal default" system_bus_variable in
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 uid = Unix.getuid () in
if stat.st_uid = 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 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
)
|
