package obus

  1. Overview
  2. Docs
package obus
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file oBus_peer.ml

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
(*
 * oBus_peer.ml
 * ------------
 * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
 * Licence   : BSD3
 *
 * This file is a part of obus, an ocaml implementation of D-Bus.
 *)

open Lwt_react

type t = {
  connection : OBus_connection.t;
  name : OBus_name.bus;
}

let compare = Pervasives.compare

let connection p = p.connection
let name p = p.name

let make ~connection ~name = { connection = connection; name = name }
let anonymous c = { connection = c; name = "" }

let ping peer =
  let%lwt reply, () =
    OBus_connection.method_call_with_message
      ~connection:peer.connection
      ~destination:OBus_protocol.bus_name
      ~path:[]
      ~interface:"org.freedesktop.DBus.Peer"
      ~member:"Peer"
      ~i_args:OBus_value.C.seq0
      ~o_args:OBus_value.C.seq0
      ()
  in
  Lwt.return { peer with name = OBus_message.sender reply }

let get_machine_id peer =
  let%lwt mid =
    OBus_connection.method_call
      ~connection:peer.connection
      ~destination:OBus_protocol.bus_name
      ~path:[]
      ~interface:"org.freedesktop.DBus.Peer"
      ~member:"GetMachineId"
      ~i_args:OBus_value.C.seq0
      ~o_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
      ()
  in
  try
    Lwt.return (OBus_uuid.of_string mid)
  with exn ->
    Lwt.fail exn

let wait_for_exit peer =
  match peer.name with
    | "" ->
        Lwt.fail (Invalid_argument "OBus_peer.wait_for_exit: peer has no name")
    | name ->
        let switch = Lwt_switch.create () in
        let%lwt owner = OBus_resolver.make ~switch peer.connection name in
        if S.value owner = "" then
          Lwt_switch.turn_off switch
        else
          (let%lwt _ = E.next (E.filter ((=) "") (S.changes owner)) in
           Lwt.return ())
          [%lwt.finally
            Lwt_switch.turn_off switch]

(* +-----------------------------------------------------------------+
   | Private peers                                                   |
   +-----------------------------------------------------------------+ *)

type peer = t

module type Private = sig
  type t = private peer
  external of_peer : peer -> t = "%identity"
  external to_peer : t -> peer = "%identity"
end

module Private =
struct
  type t = peer
  external of_peer : peer -> t = "%identity"
  external to_peer : t -> peer = "%identity"
end