Import obus_1.2.4.orig.tar.gz

[dgit import orig obus_1.2.4.orig.tar.gz]

207 files changed, 25248 insertions, 0 deletions

diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS
new file mode 100644
index 0000000..a0e60b4
--- /dev/null
+++ b/.github/CODEOWNERS
@@ -0,0 +1,3 @@
+# These are the default owners for everything in the repo. They will
+# be requested for review when someone opens a pull request.
+* @diml @pmetzger @Freyr666
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..032c388
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+_build/
+.merlin
\ No newline at end of file
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..b8cb38a
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,14 @@
+language: c
+sudo: required
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
+script: bash -ex .travis-opam.sh
+sudo: required
+env:
+  matrix:
+    - OCAML_VERSION=4.04
+    - OCAML_VERSION=4.05
+    - OCAML_VERSION=4.06
+    - OCAML_VERSION=4.07
+    - OCAML_VERSION=4.08
+os:
+  - linux
diff --git a/CHANGES.md b/CHANGES.md
new file mode 100644
index 0000000..f597d6f
--- /dev/null
+++ b/CHANGES.md
@@ -0,0 +1,65 @@
+1.2.0 (2019-07-04)
+------------------
+
+* opam: add dependency on `menhir`, `ppxlib`
+* opam: remove dependency on `camlp4`, `lwt_camlp4`
+* switch to dune build system
+* replace Camlp4-based parser with the one generated by Menhir
+* remove all Camlp4 dependencies
+* replace Camlp4-based syntax module with obus.ppx
+
+1.1.8 (2018-06-02)
+------------------
+
+* opam: add dependency on `oasis`, `lwt_react`, `lwt_camlp4`, `lwt_log`
+* opam: `ocamlfind` is now a build dependency
+* add support for OCaml 4.06 and `lwt` 3
+* bump minimum OCaml version to 4.02.3
+* enable travis tests
+* fix missing signature validation
+
+1.1.7 (2016-07-18)
+------------------
+
+* fix compatibility with OCaml 4.03.0
+
+1.1.6 (2014-04-21)
+------------------
+
+* support for React 1.0.0
+
+1.1.5 (2012-10-02)
+------------------
+
+* compatibility fix for type-conv
+
+1.1.4 (2012-07-30)
+------------------
+
+* update oasis files
+* minor fixes
+
+1.1.3 (2011-07-29)
+------------------
+
+* depends on type-conv instead of type-conv.syntax
+* implements version 0.18 of the specification:
+    * add the `eavesdrop` match keyword
+
+1.1.2 (2011-04-12)
+------------------
+
+* implement property monitoring for upower, udisks and network-manager
+* implement new D-Bus errors (UnknownObject, UnknownInterface, ...)
+* update and implement new argument filters (argNpath and argNnamespace)
+
+1.1.1 (2011-02-14)
+------------------
+
+* Fix a race condition in servers that may causes authentication to hang
+* Add support for launchd addresses
+
+1.1 (2010-12-13)
+----------------
+
+  * First stable release
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..6d9ae61
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,24 @@
+Copyright (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+All rights reserved.
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Jeremie Dimino nor the names of his
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..8c64364
--- /dev/null
+++ b/README.md
@@ -0,0 +1,81 @@
+OBus
+====
+
+[![Build Status](https://travis-ci.com/ocaml-community/obus.svg?branch=master)](https://travis-ci.com/ocaml-community/obus)
+
+OBus is a pure OCaml implementation of the D-Bus protocol.  It aims to
+provide a clean and easy way for ocaml programmers to access and
+provide D-Bus services.
+
+OBus is using the cooperative threading library Lwt, which make it
+very simple to fully exploit the asynchronous nature of D-Bus.
+
+Dependencies
+------------
+
+Make sure you have [dune](https://dune.build/)
+installed, and install all the missing dependencies listed in
+the output of this command:
+
+    $ dune external-lib-deps @install --missing
+
+Installation
+------------
+
+The recommended way to install obus and its dependencies is via
+[opam](https://opam.ocaml.org/): `opam install obus`.
+
+Manual installation from sources
+--------------------------------
+
+To build and install obus:
+
+    $ dune build @install
+
+### Tests _(optionnal)_
+
+To build and execute tests:
+
+    $ dune runtest
+
+Using the library
+-----------------
+
+OBus install the following packages:
+
+* `obus`: the core library, implementing the D-Bus protocol,
+* `obus.ppx`: syntax extensions to aid registering OBus exceptions.
+* `obus.notification`: interface to the freedesktop Notification
+  service,
+* `obus.hal`: interface to the freedesktop Hal service,
+* `obus.upower`: interface to the freedesktop UPower service,
+* `obus.udisks`: interface to the freedesktop UDisks service,
+* `obus.policykit`: interface to the freedesktop PolicyKit servie.
+
+Using the tools
+---------------
+
+There are several tools provided in the obus distribution:
+
+* `obus-dump`, to execute a command and dump all messages that goes
+  throug the session and/or system message bus,
+* `obus-introspect` which can recursively introspect a D-Bus service,
+* `obus-gen-interface`, to convert D-Bus introspection files into
+   ocaml definition modules,
+* `obus-gen-client` and obus-gen-server which can generate template
+   for using or implementing D-Bus servies,
+* `obus-xml2idl` and obus-idl2xml to convert xml introspection
+   documents to the obus idl format, and vice versa.
+
+There are manual pages for all this tools.
+
+The caml files generated by obus-gen-client and obus-gen-server are
+meant to be edited and adapted. In practice introspections files
+contains only marshaling informations so it is often not sufficient
+for creating a usable binding.
+
+Here is a simple example of use of the tools:
+
+    $ obus-introspect org.freedesktop.Notifications /org/freedesktop/Notifications > notif.xml
+    $ obus-gen-interface notif.xml
+    $ obus-gen-client notif.xml
diff --git a/bindings/hal/dune b/bindings/hal/dune
new file mode 100644
index 0000000..7e9e8db
--- /dev/null
+++ b/bindings/hal/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_hal)
+ (public_name obus.hal)
+ (wrapped false)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets hal_interfaces.ml hal_interfaces.mli)
+ (deps    hal_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o hal_interfaces %{deps})))
diff --git a/bindings/hal/hal_device.ml b/bindings/hal/hal_device.ml
new file mode 100644
index 0000000..40ae375
--- /dev/null
+++ b/bindings/hal/hal_device.ml
@@ -0,0 +1,337 @@
+(*
+ * hal_device.ml
+ * -------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+open OBus_value
+open Hal_interfaces
+
+include OBus_proxy.Private
+
+type udi = OBus_path.t
+
+let udi = OBus_proxy.path
+
+let computer () =
+  let%lwt bus = OBus_bus.system () in
+  return (OBus_proxy.make
+            (OBus_peer.make bus "org.freedesktop.Hal")
+            ["org"; "freedesktop"; "Hal"; "devices"; "computer"])
+
+
+type property =
+  | Pstring of string
+  | Pstrlist of string list
+  | Pint of int32
+  | Puint64 of int64
+  | Pbool of bool
+  | Pdouble of float
+
+let property_of_variant = function
+  | V.Basic(V.String s) -> Pstring s
+  | V.Array(T.Basic T.String, _) as l -> Pstrlist(C.cast_single (C.array C.basic_string) l)
+  | V.Basic(V.Int32 x) -> Pint x
+  | V.Basic(V.Uint64 x) -> Puint64 x
+  | V.Basic(V.Boolean x) -> Pbool x
+  | V.Basic(V.Double x) -> Pdouble x
+  | v -> Printf.ksprintf failwith "Hal_device.property_of_variant: invalid device property: %s" (V.string_of_single v)
+
+let variant_of_property = function
+  | Pstring s -> V.basic_string s
+  | Pstrlist l -> C.make_single (C.array C.basic_string) l
+  | Pint x -> V.basic_int32 x
+  | Puint64 x -> V.basic_uint64 x
+  | Pbool x -> V.basic_boolean x
+  | Pdouble x -> V.basic_double x
+
+open Org_freedesktop_Hal_Device
+
+let get_all_properties proxy =
+  let%lwt l = OBus_method.call m_GetAllProperties proxy () in
+  return (List.map (fun (name, value) -> (name, property_of_variant value)) l)
+
+let set_multiple_properties proxy properties =
+  OBus_method.call m_SetMultipleProperties proxy
+    (List.map (fun (name, property) -> (name, variant_of_property property)) properties)
+
+let get_property proxy key =
+  OBus_method.call m_GetProperty proxy key >|= property_of_variant
+
+let get_property_string proxy key =
+  OBus_method.call m_GetPropertyString proxy key
+
+let get_property_string_list proxy key =
+  OBus_method.call m_GetPropertyStringList proxy key
+
+let get_property_integer proxy key =
+  let%lwt value = OBus_method.call m_GetPropertyInteger proxy key in
+  let value = Int32.to_int value in
+  return value
+
+let get_property_boolean proxy key =
+  OBus_method.call m_GetPropertyBoolean proxy key
+
+let get_property_double proxy key =
+  OBus_method.call m_GetPropertyDouble proxy key
+
+let set_property proxy key value =
+  OBus_method.call m_SetProperty proxy (key, variant_of_property value)
+
+let set_property_string proxy key value =
+  OBus_method.call m_SetPropertyString proxy (key, value)
+
+let set_property_string_list proxy key value =
+  OBus_method.call m_SetPropertyStringList proxy (key, value)
+
+let set_property_integer proxy key value =
+  let value = Int32.of_int value in
+  OBus_method.call m_SetPropertyInteger proxy (key, value)
+
+let set_property_boolean proxy key value =
+  OBus_method.call m_SetPropertyBoolean proxy (key, value)
+
+let set_property_double proxy key value =
+  OBus_method.call m_SetPropertyDouble proxy (key, value)
+
+let remove_property proxy key =
+  OBus_method.call m_RemoveProperty proxy key
+
+let get_property_type proxy key =
+  let%lwt typ = OBus_method.call m_GetPropertyType proxy key in
+  let typ = Int32.to_int typ in
+  return typ
+
+let property_exists proxy key =
+  OBus_method.call m_PropertyExists proxy key
+
+let add_capability proxy capability =
+  OBus_method.call m_AddCapability proxy capability
+
+let query_capability proxy capability =
+  OBus_method.call m_QueryCapability proxy capability
+
+let lock proxy reason =
+  OBus_method.call m_Lock proxy reason
+
+let unlock proxy =
+  OBus_method.call m_Unlock proxy ()
+
+let acquire_interface_lock proxy interface_name exclusive =
+  OBus_method.call m_AcquireInterfaceLock proxy (interface_name, exclusive)
+
+let release_interface_lock proxy interface_name =
+  OBus_method.call m_ReleaseInterfaceLock proxy interface_name
+
+let is_caller_locked_out proxy interface_name caller_sysbus_name =
+  OBus_method.call m_IsCallerLockedOut proxy (interface_name, caller_sysbus_name)
+
+let is_caller_privileged proxy action caller_sysbus_name =
+  OBus_method.call m_IsCallerPrivileged proxy (action, caller_sysbus_name)
+
+let is_locked_by_others proxy interface_name =
+  OBus_method.call m_IsLockedByOthers proxy interface_name
+
+let string_list_append proxy key value =
+  OBus_method.call m_StringListAppend proxy (key, value)
+
+let string_list_prepend proxy key value =
+  OBus_method.call m_StringListPrepend proxy (key, value)
+
+let string_list_remove proxy key value =
+  OBus_method.call m_StringListRemove proxy (key, value)
+
+let emit_condition proxy condition_name condition_details =
+  OBus_method.call m_EmitCondition proxy (condition_name, condition_details)
+
+let rescan proxy =
+  OBus_method.call m_Rescan proxy ()
+
+let reprobe proxy =
+  OBus_method.call m_Reprobe proxy ()
+
+let claim_interface proxy interface_name introspection_xml =
+  OBus_method.call m_ClaimInterface proxy (interface_name, introspection_xml)
+
+let addon_is_ready proxy =
+  OBus_method.call m_AddonIsReady proxy ()
+
+let property_modified proxy =
+  OBus_signal.map
+    (fun (num_updates, updates) ->
+       let num_updates = Int32.to_int num_updates in
+       (num_updates, updates))
+    (OBus_signal.make s_PropertyModified proxy)
+
+let condition proxy =
+  OBus_signal.make s_Condition proxy
+
+let interface_lock_acquired proxy =
+  OBus_signal.map
+    (fun (interface_name, lock_holder, num_locks) ->
+       let num_locks = Int32.to_int num_locks in
+       (interface_name, lock_holder, num_locks))
+    (OBus_signal.make s_InterfaceLockAcquired proxy)
+
+let interface_lock_released proxy =
+  OBus_signal.map
+    (fun (interface_name, lock_holder, num_locks) ->
+       let num_locks = Int32.to_int num_locks in
+       (interface_name, lock_holder, num_locks))
+    (OBus_signal.make s_InterfaceLockReleased proxy)
+
+module Volume = struct
+  open Org_freedesktop_Hal_Device_Volume
+
+  let mount proxy mount_point fstype extra_options =
+    let%lwt return_code = OBus_method.call m_Mount proxy (mount_point, fstype, extra_options) in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let unmount proxy extra_options =
+    let%lwt return_code = OBus_method.call m_Unmount proxy extra_options in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let eject proxy extra_options =
+    let%lwt return_code = OBus_method.call m_Eject proxy extra_options in
+    let return_code = Int32.to_int return_code in
+    return return_code
+end
+
+module Storage = struct
+  open Org_freedesktop_Hal_Device_Storage
+
+  let eject proxy extra_options =
+    let%lwt return_code = OBus_method.call m_Eject proxy extra_options in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let close_tray proxy extra_options =
+    let%lwt return_code = OBus_method.call m_CloseTray proxy extra_options in
+    let return_code = Int32.to_int return_code in
+    return return_code
+end
+
+module Storage_removable = struct
+  open Org_freedesktop_Hal_Device_Storage_Removable
+
+  let check_for_media proxy =
+    OBus_method.call m_CheckForMedia proxy ()
+end
+
+module Wake_on_lan = struct
+  open Org_freedesktop_Hal_Device_WakeOnLan
+
+  let get_supported proxy =
+    let%lwt return_code = OBus_method.call m_GetSupported proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let get_enabled proxy =
+    let%lwt return_code = OBus_method.call m_GetEnabled proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let set_enabled proxy enable =
+    let%lwt return_code = OBus_method.call m_SetEnabled proxy enable in
+    let return_code = Int32.to_int return_code in
+    return return_code
+end
+
+module System_power_management = struct
+  open Org_freedesktop_Hal_Device_SystemPowerManagement
+
+  let suspend proxy num_seconds_to_sleep =
+    let num_seconds_to_sleep = Int32.of_int num_seconds_to_sleep in
+    let%lwt return_code = OBus_method.call m_Suspend proxy num_seconds_to_sleep in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let suspend_hybrid proxy num_seconds_to_sleep =
+    let num_seconds_to_sleep = Int32.of_int num_seconds_to_sleep in
+    let%lwt return_code = OBus_method.call m_SuspendHybrid proxy num_seconds_to_sleep in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let hibernate proxy =
+    let%lwt return_code = OBus_method.call m_Hibernate proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let shutdown proxy =
+    let%lwt return_code = OBus_method.call m_Shutdown proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let reboot proxy =
+    let%lwt return_code = OBus_method.call m_Reboot proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let set_power_save proxy enable_power_save =
+    let%lwt return_code = OBus_method.call m_SetPowerSave proxy enable_power_save in
+    let return_code = Int32.to_int return_code in
+    return return_code
+end
+
+module Cpufreq = struct
+  open Org_freedesktop_Hal_Device_CPUFreq
+
+  let set_cpufreq_governor proxy governor_string =
+    OBus_method.call m_SetCPUFreqGovernor proxy governor_string
+
+  let set_cpufreq_performance proxy value =
+    let value = Int32.of_int value in
+    OBus_method.call m_SetCPUFreqPerformance proxy value
+
+  let set_cpufreq_consider_nice proxy value =
+    OBus_method.call m_SetCPUFreqConsiderNice proxy value
+
+  let get_cpufreq_governor proxy =
+    OBus_method.call m_GetCPUFreqGovernor proxy ()
+
+  let get_cpufreq_performance proxy =
+    let%lwt return_code = OBus_method.call m_GetCPUFreqPerformance proxy () in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let get_cpufreq_consider_nice proxy =
+    OBus_method.call m_GetCPUFreqConsiderNice proxy ()
+
+  let get_cpufreq_available_governors proxy =
+    OBus_method.call m_GetCPUFreqAvailableGovernors proxy ()
+end
+
+module Laptop_panel = struct
+  open Org_freedesktop_Hal_Device_LaptopPanel
+
+  let set_brightness proxy brightness_value =
+    let brightness_value = Int32.of_int brightness_value in
+    let%lwt return_code = OBus_method.call m_SetBrightness proxy brightness_value in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let get_brightness proxy =
+    let%lwt brightness_value = OBus_method.call m_GetBrightness proxy () in
+    let brightness_value = Int32.to_int brightness_value in
+    return brightness_value
+end
+
+module Kill_switch = struct
+  open Org_freedesktop_Hal_Device_KillSwitch
+
+  let set_power proxy value =
+    let%lwt return_code = OBus_method.call m_SetPower proxy value in
+    let return_code = Int32.to_int return_code in
+    return return_code
+
+  let get_power proxy =
+    let%lwt value = OBus_method.call m_GetPower proxy () in
+    let value = Int32.to_int value in
+    return value
+end
diff --git a/bindings/hal/hal_device.mli b/bindings/hal/hal_device.mli
new file mode 100644
index 0000000..b02a382
--- /dev/null
+++ b/bindings/hal/hal_device.mli
@@ -0,0 +1,135 @@
+(*
+ * hal_device.mli
+ * --------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Hal devices *)
+
+include OBus_proxy.Private
+
+type udi = OBus_path.t
+    (** Unique Device Identifier *)
+
+val udi : t -> udi
+  (** Return the udi of a device *)
+
+val computer : unit -> t Lwt.t
+  (** The computer device *)
+
+type property =
+    (** A device property *)
+  | Pstring of string
+      (** An UTF8 string *)
+  | Pstrlist of string list
+      (** List of UTF8 strings *)
+  | Pint of int32
+      (** 32-bit signed integer *)
+  | Puint64 of int64
+      (** 64-bit unsigned integer *)
+  | Pbool of bool
+  | Pdouble of float
+      (** IEEE754 double precision floating point number  *)
+
+val property_of_variant : OBus_value.V.single -> property
+  (** Tries to convert the given variant into a property *)
+
+val variant_of_property : property -> OBus_value.V.single
+  (** Converts the gievn property into a D-Bus variant *)
+
+(** {6 Common device interface} *)
+
+val get_all_properties : t -> (string * property) list Lwt.t
+val set_multiple_properties : t -> (string * property) list -> unit Lwt.t
+val get_property : t -> string -> property Lwt.t
+val get_property_string : t -> string -> string Lwt.t
+val get_property_string_list : t -> string -> string list Lwt.t
+val get_property_integer : t -> string -> int Lwt.t
+val get_property_boolean : t -> string -> bool Lwt.t
+val get_property_double : t -> string -> float Lwt.t
+val set_property : t -> string -> property -> unit Lwt.t
+val set_property_string : t -> string -> string -> unit Lwt.t
+val set_property_string_list : t -> string -> string list -> unit Lwt.t
+val set_property_integer : t -> string -> int -> unit Lwt.t
+val set_property_boolean : t -> string -> bool -> unit Lwt.t
+val set_property_double : t -> string -> float -> unit Lwt.t
+val remove_property : t -> string -> unit Lwt.t
+val get_property_type : t -> string -> int Lwt.t
+val property_exists : t -> string -> bool Lwt.t
+val add_capability : t -> string -> unit Lwt.t
+val query_capability : t -> string -> bool Lwt.t
+val lock : t -> string -> bool Lwt.t
+val unlock : t -> bool Lwt.t
+val acquire_interface_lock : t -> string -> bool -> unit Lwt.t
+val release_interface_lock : t -> string -> unit Lwt.t
+val is_caller_locked_out : t -> string -> string -> bool Lwt.t
+val is_caller_privileged : t -> string -> string -> string Lwt.t
+val is_locked_by_others : t -> string -> bool Lwt.t
+val string_list_append : t -> string -> string -> unit Lwt.t
+val string_list_prepend : t -> string -> string -> unit Lwt.t
+val string_list_remove : t -> string -> string -> unit Lwt.t
+val emit_condition : t -> string -> string -> bool Lwt.t
+val rescan : t -> bool Lwt.t
+val reprobe : t -> bool Lwt.t
+val claim_interface : t -> string -> string -> bool Lwt.t
+val addon_is_ready : t -> bool Lwt.t
+
+val property_modified : t -> (int * (string * bool * bool) list) OBus_signal.t
+val condition : t -> (string * string) OBus_signal.t
+val interface_lock_acquired : t -> (string * string * int) OBus_signal.t
+val interface_lock_released : t -> (string * string * int) OBus_signal.t
+
+(** {6 Specifics interfaces} *)
+
+module Volume : sig
+  val mount : t -> string -> string -> string list -> int Lwt.t
+  val unmount : t -> string list -> int Lwt.t
+  val eject : t -> string list -> int Lwt.t
+end
+
+module Storage : sig
+  val eject : t -> string list -> int Lwt.t
+  val close_tray : t -> string list -> int Lwt.t
+end
+
+module Storage_removable : sig
+  val check_for_media : t -> bool Lwt.t
+end
+
+module Wake_on_lan : sig
+  val get_supported : t -> int Lwt.t
+  val get_enabled : t -> int Lwt.t
+  val set_enabled : t -> bool -> int Lwt.t
+end
+
+module System_power_management : sig
+  val suspend : t -> int -> int Lwt.t
+  val suspend_hybrid : t -> int -> int Lwt.t
+  val hibernate : t -> int Lwt.t
+  val shutdown : t -> int Lwt.t
+  val reboot : t -> int Lwt.t
+  val set_power_save : t -> bool -> int Lwt.t
+end
+
+module Cpufreq : sig
+  val set_cpufreq_governor : t -> string -> unit Lwt.t
+  val set_cpufreq_performance : t -> int -> unit Lwt.t
+  val set_cpufreq_consider_nice : t -> bool -> unit Lwt.t
+  val get_cpufreq_governor : t -> string Lwt.t
+  val get_cpufreq_performance : t -> int Lwt.t
+  val get_cpufreq_consider_nice : t -> bool Lwt.t
+  val get_cpufreq_available_governors : t -> string list Lwt.t
+end
+
+module Laptop_panel : sig
+  val set_brightness : t -> int -> int Lwt.t
+  val get_brightness : t -> int Lwt.t
+end
+
+module Kill_switch : sig
+  val set_power : t -> bool -> int Lwt.t
+  val get_power : t -> int Lwt.t
+end
diff --git a/bindings/hal/hal_interfaces.obus b/bindings/hal/hal_interfaces.obus
new file mode 100644
index 0000000..7a8198c
--- /dev/null
+++ b/bindings/hal/hal_interfaces.obus
@@ -0,0 +1,128 @@
+(*
+ * hal_interfaces.obus
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.Hal.Device {
+  method GetAllProperties : () -> (properties : (string, variant) dict)
+  method SetMultipleProperties : (properties : (string, variant) dict) -> ()
+  method GetProperty : (key : string) -> (value : variant)
+  method GetPropertyString : (key : string) -> (value : string)
+  method GetPropertyStringList : (key : string) -> (value : string array)
+  method GetPropertyInteger : (key : string) -> (value : int32)
+  method GetPropertyBoolean : (key : string) -> (value : boolean)
+  method GetPropertyDouble : (key : string) -> (value : double)
+  method SetProperty : (key : string, value : variant) -> ()
+  method SetPropertyString : (key : string, value : string) -> ()
+  method SetPropertyStringList : (key : string, value : string array) -> ()
+  method SetPropertyInteger : (key : string, value : int32) -> ()
+  method SetPropertyBoolean : (key : string, value : boolean) -> ()
+  method SetPropertyDouble : (key : string, value : double) -> ()
+  method RemoveProperty : (key : string) -> ()
+  method GetPropertyType : (key : string) -> (type : int32)
+  method PropertyExists : (key : string) -> (does_it_exist : boolean)
+  method AddCapability : (capability : string) -> ()
+  method QueryCapability : (capability : string) -> (does_it_have_capability : boolean)
+  method Lock : (reason : string) -> (acquired_lock : boolean)
+  method Unlock : () -> (released_lock : boolean)
+  method AcquireInterfaceLock : (interface_name : string, exclusive : boolean) -> ()
+  method ReleaseInterfaceLock : (interface_name : string) -> ()
+  method IsCallerLockedOut : (interface_name : string, caller_sysbus_name : string) -> (whether_caller_is_locked_out : boolean)
+  method IsCallerPrivileged : (action : string, caller_sysbus_name : string) -> (result : string)
+  method IsLockedByOthers : (interface_name : string) -> (whether_it_is_locked_by_others : boolean)
+  method StringListAppend : (key : string, value : string) -> ()
+  method StringListPrepend : (key : string, value : string) -> ()
+  method StringListRemove : (key : string, value : string) -> ()
+  method EmitCondition : (condition_name : string, condition_details : string) -> (rc : boolean)
+  method Rescan : () -> (call_had_sideeffect : boolean)
+  method Reprobe : () -> (call_had_sideeffect : boolean)
+  method ClaimInterface : (interface_name : string, introspection_xml : string) -> (rc : boolean)
+  method AddonIsReady : () -> (rc : boolean)
+  signal PropertyModified : (num_updates : int32, updates : (string * boolean * boolean) array)
+  signal Condition : (cond_name : string, cond_details : string)
+  signal InterfaceLockAcquired : (interface_name : string, lock_holder : string, num_locks : int32)
+  signal InterfaceLockReleased : (interface_name : string, lock_holder : string, num_locks : int32)
+}
+
+interface org.freedesktop.Hal.Device.CPUFreq {
+  method SetCPUFreqGovernor : (governor_string : string) -> ()
+  method SetCPUFreqPerformance : (value : int32) -> ()
+  method SetCPUFreqConsiderNice : (value : boolean) -> ()
+  method GetCPUFreqGovernor : () -> (return_code : string)
+  method GetCPUFreqPerformance : () -> (return_code : int32)
+  method GetCPUFreqConsiderNice : () -> (return_code : boolean)
+  method GetCPUFreqAvailableGovernors : () -> (return_code : string array)
+}
+
+interface org.freedesktop.Hal.Device.KillSwitch {
+  method SetPower : (value : boolean) -> (return_code : int32)
+  method GetPower : () -> (value : int32)
+}
+
+interface org.freedesktop.Hal.Device.LaptopPanel {
+  method SetBrightness : (brightness_value : int32) -> (return_code : int32)
+  method GetBrightness : () -> (brightness_value : int32)
+}
+
+interface org.freedesktop.Hal.Device.Leds {
+  method SetBrightness : (brightness_value : int32) -> (return_code : int32)
+  method GetBrightness : () -> (brightness_value : int32)
+}
+
+interface org.freedesktop.Hal.Device.Storage {
+  method Eject : (options : string array) -> (result : int32)
+  method CloseTray : (options : string array) -> (result : int32)
+}
+
+interface org.freedesktop.Hal.Device.Storage.Removable {
+  method CheckForMedia : () -> (call_had_sideeffect : boolean)
+}
+
+interface org.freedesktop.Hal.Device.SystemPowerManagement {
+  method Suspend : (num_seconds_to_sleep : int32) -> (return_code : int32)
+  method SuspendHybrid : (num_seconds_to_sleep : int32) -> (return_code : int32)
+  method Hibernate : () -> (return_code : int32)
+  method Shutdown : () -> (return_code : int32)
+  method Reboot : () -> (return_code : int32)
+  method SetPowerSave : (enable_power_save : boolean) -> (return_code : int32)
+}
+
+interface org.freedesktop.Hal.Device.Volume {
+  method Mount : (mount_point : string, fstype : string, options : string array) -> (result : int32)
+  method Unmount : (options : string array) -> (result : int32)
+  method Eject : (options : string array) -> (result : int32)
+}
+
+interface org.freedesktop.Hal.Device.Volume.Crypto {
+  method Setup : (passphrase : string) -> (result : int32)
+  method Teardown : () -> (result : int32)
+}
+
+interface org.freedesktop.Hal.Device.WakeOnLan {
+  method GetSupported : () -> (return_code : int32)
+  method GetEnabled : () -> (return_code : int32)
+  method SetEnabled : (enable : boolean) -> (return_code : int32)
+}
+
+interface org.freedesktop.Hal.Manager {
+  method GetAllDevices : () -> (devices : string array)
+  method GetAllDevicesWithProperties : () -> (devices_with_props : (string * (string, variant) dict) array)
+  method DeviceExists : (udi : string) -> (does_it_exist : boolean)
+  method FindDeviceStringMatch : (key : string, value : string) -> (devices : string array)
+  method FindDeviceByCapability : (capability : string) -> (devices : string array)
+  method NewDevice : () -> (temporary_udi : string)
+  method Remove : (udi : string) -> ()
+  method CommitToGdl : (temporary_udi : string, global_udi : string) -> ()
+  method AcquireGlobalInterfaceLock : (interface_name : string, exclusive : boolean) -> ()
+  method ReleaseGlobalInterfaceLock : (interface_name : string) -> ()
+  method SingletonAddonIsReady : (command_line : string) -> ()
+  signal DeviceAdded : (udi : string)
+  signal DeviceRemoved : (udi : string)
+  signal NewCapability : (udi : string, cap_name : string)
+  signal GlobalInterfaceLockAcquired : (interface_name : string, lock_holder : string, num_locks : int32)
+  signal GlobalInterfaceLockReleased : (interface_name : string, lock_holder : string, num_locks : int32)
+}
diff --git a/bindings/hal/hal_manager.ml b/bindings/hal/hal_manager.ml
new file mode 100644
index 0000000..64ca3df
--- /dev/null
+++ b/bindings/hal/hal_manager.ml
@@ -0,0 +1,98 @@
+(*
+ * hal_manager.ml
+ * --------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+open OBus_value
+
+include OBus_proxy.Private
+
+
+let manager () =
+  let%lwt bus = OBus_bus.system () in
+  return (OBus_proxy.make
+            (OBus_peer.make bus "org.freedesktop.Hal")
+            [ "org"; "freedesktop"; "Hal"; "Manager" ])
+
+open Hal_interfaces.Org_freedesktop_Hal_Manager
+
+let make_device context udi =
+  Hal_device.of_proxy
+    (OBus_proxy.make (OBus_context.sender context)
+       (OBus_path.of_string udi))
+
+let get_all_devices proxy =
+  let%lwt context, l = OBus_method.call_with_context m_GetAllDevices proxy () in
+  return (List.map (make_device context) l)
+
+let get_all_devices_with_properties proxy =
+  let%lwt context, l = OBus_method.call_with_context m_GetAllDevicesWithProperties proxy () in
+  return (List.map
+            (fun (udi, properties) ->
+               (make_device context udi,
+                List.map (fun (name, value) -> (name, Hal_device.property_of_variant value)) properties))
+            l)
+
+let device_exists proxy udi =
+  OBus_method.call m_DeviceExists proxy (OBus_path.to_string udi)
+
+let find_device_string_match proxy key value =
+  let%lwt context, l = OBus_method.call_with_context m_FindDeviceStringMatch proxy (key, value) in
+  return (List.map (make_device context) l)
+
+let find_device_by_capability proxy capability =
+  let%lwt context, l = OBus_method.call_with_context m_FindDeviceByCapability proxy capability in
+  return (List.map (make_device context) l)
+
+let new_device proxy =
+  let%lwt context, udi = OBus_method.call_with_context m_NewDevice proxy () in
+  return (make_device context udi)
+
+let remove proxy dev =
+  OBus_method.call m_Remove proxy (OBus_path.to_string (Hal_device.udi dev))
+
+let commit_to_gdl proxy temporary_udi global_udi =
+  OBus_method.call m_CommitToGdl proxy (temporary_udi, global_udi)
+
+let acquire_global_interface_lock proxy interface_name exclusive =
+  OBus_method.call m_AcquireGlobalInterfaceLock proxy (interface_name, exclusive)
+
+let release_global_interface_lock proxy interface_name =
+  OBus_method.call m_ReleaseGlobalInterfaceLock proxy interface_name
+
+let singleton_addon_is_ready proxy command_line =
+  OBus_method.call m_SingletonAddonIsReady proxy command_line
+
+let device_added proxy =
+  OBus_signal.map_with_context
+    make_device
+    (OBus_signal.make s_DeviceAdded proxy)
+
+let device_removed proxy =
+  OBus_signal.map_with_context
+    make_device
+    (OBus_signal.make s_DeviceRemoved proxy)
+
+let new_capability proxy =
+  OBus_signal.map_with_context
+    (fun context (udi, cap) -> (make_device context udi, cap))
+    (OBus_signal.make s_NewCapability proxy)
+
+let global_interface_lock_acquired proxy =
+  OBus_signal.map
+    (fun (interface_name, lock_holder, num_locks) ->
+       let num_locks = Int32.to_int num_locks in
+       (interface_name, lock_holder, num_locks))
+    (OBus_signal.make s_GlobalInterfaceLockAcquired proxy)
+
+let global_interface_lock_released proxy =
+  OBus_signal.map
+    (fun (interface_name, lock_holder, num_locks) ->
+       let num_locks = Int32.to_int num_locks in
+       (interface_name, lock_holder, num_locks))
+    (OBus_signal.make s_GlobalInterfaceLockReleased proxy)
diff --git a/bindings/hal/hal_manager.mli b/bindings/hal/hal_manager.mli
new file mode 100644
index 0000000..b49d04d
--- /dev/null
+++ b/bindings/hal/hal_manager.mli
@@ -0,0 +1,33 @@
+(*
+ * hal_manager.mli
+ * ---------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** The Hal manager *)
+
+include OBus_proxy.Private
+
+val manager : unit -> t Lwt.t
+  (** The Hal manager *)
+
+val get_all_devices : t -> Hal_device.t list Lwt.t
+val get_all_devices_with_properties : t -> (Hal_device.t * (string * Hal_device.property) list) list Lwt.t
+val device_exists : t -> Hal_device.udi -> bool Lwt.t
+val find_device_string_match : t -> string -> string -> Hal_device.t list Lwt.t
+val find_device_by_capability : t -> string -> Hal_device.t list Lwt.t
+val new_device : t -> Hal_device.t Lwt.t
+val remove : t -> Hal_device.t -> unit Lwt.t
+val commit_to_gdl : t -> string -> string -> unit Lwt.t
+val acquire_global_interface_lock : t -> string -> bool -> unit Lwt.t
+val release_global_interface_lock : t -> string -> unit Lwt.t
+val singleton_addon_is_ready : t -> string -> unit Lwt.t
+
+val device_added : t -> Hal_device.t OBus_signal.t
+val device_removed : t -> Hal_device.t OBus_signal.t
+val new_capability : t -> (Hal_device.t * string) OBus_signal.t
+val global_interface_lock_acquired : t -> (string * string * int) OBus_signal.t
+val global_interface_lock_released : t -> (string * string * int) OBus_signal.t
diff --git a/bindings/network-manager/dune b/bindings/network-manager/dune
new file mode 100644
index 0000000..456dbff
--- /dev/null
+++ b/bindings/network-manager/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_network_manager)
+ (public_name obus.network_manager)
+ (wrapped false)
+ (libraries lwt lwt_log obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets nm_interfaces.ml nm_interfaces.mli)
+ (deps    nm_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o nm_interfaces %{deps})))
diff --git a/bindings/network-manager/nm_access_point.ml b/bindings/network-manager/nm_access_point.ml
new file mode 100644
index 0000000..85ca05d
--- /dev/null
+++ b/bindings/network-manager/nm_access_point.ml
@@ -0,0 +1,95 @@
+(*
+ * nm_access_point.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+open Lwt
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_AccessPoint
+
+type ap_flag =
+    [ `Privacy ]
+
+let flags proxy =
+  OBus_property.map_r
+    (fun n -> if (Int32.to_int n) land 0x01 <> 0 then [`Privacy] else [])
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Flags proxy)
+
+type ap_security_flag =
+    [ `Pair_wep40
+    | `Pair_wep104
+    | `Pair_tkip
+    | `Pair_ccmp
+    | `Group_wep40
+    | `Group_wep104
+    | `Group_tkip
+    | `Group_ccmp
+    | `Key_mgmt_psk
+    | `Key_mgmt_802_1x ]
+
+let ap_security_flags_of_int32 n =
+  let n = Int32.to_int n in
+  let add l bit_mask flag =
+    if n land bit_mask <> 0 then
+      flag :: l
+    else
+      l
+  in
+  let l = [] in
+  let l = add l 0x001 `Pair_wep40 in
+  let l = add l 0x002 `Pair_wep104 in
+  let l = add l 0x004 `Pair_tkip in
+  let l = add l 0x008 `Pair_ccmp in
+  let l = add l 0x010 `Group_wep40 in
+  let l = add l 0x020 `Group_wep104 in
+  let l = add l 0x040 `Group_tkip in
+  let l = add l 0x080 `Group_ccmp in
+  let l = add l 0x100 `Key_mgmt_psk in
+  let l = add l 0x200 `Key_mgmt_802_1x in
+  l
+
+let wpa_flags proxy =
+  OBus_property.map_r
+    ap_security_flags_of_int32
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_WpaFlags proxy)
+
+let rsn_flags proxy =
+  OBus_property.map_r
+    ap_security_flags_of_int32
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_RsnFlags proxy)
+
+let ssid proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Ssid proxy
+
+let frequency proxy =
+  OBus_property.map_r
+    Int32.to_int
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Frequency proxy)
+
+let hw_address proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy
+
+let mode proxy =
+  OBus_property.map_r
+    Int32.to_int
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Mode proxy)
+
+let max_bitrate proxy =
+  OBus_property.map_r
+    Int32.to_int
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_MaxBitrate proxy)
+
+let strength proxy =
+  OBus_property.map_r
+    int_of_char
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Strength proxy)
+
+let properties_changed proxy =
+  OBus_signal.make s_PropertiesChanged proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
diff --git a/bindings/network-manager/nm_access_point.mli b/bindings/network-manager/nm_access_point.mli
new file mode 100644
index 0000000..320c9cf
--- /dev/null
+++ b/bindings/network-manager/nm_access_point.mli
@@ -0,0 +1,59 @@
+(*
+ * nm_access_point.mli
+ * -------------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Access point interface *)
+
+include OBus_proxy.Private
+
+(** {6 Signals} *)
+
+val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+(** {6 Properties} *)
+
+type ap_flag =
+    [ `Privacy (** Access point supports privacy measures. *) ]
+
+val flags : t -> ap_flag list OBus_property.r
+
+type ap_security_flag =
+    [ `Pair_wep40
+        (** Access point supports pairwise 40-bit WEP encryption *)
+    | `Pair_wep104
+        (** Access point supports pairwise 104-bit WEP encryption *)
+    | `Pair_tkip
+        (** Access point supports pairwise TKIP encryption *)
+    | `Pair_ccmp
+        (** Access point supports pairwise CCMP encryption *)
+    | `Group_wep40
+        (** Access point supports a group 40-bit WEP cipher *)
+    | `Group_wep104
+        (** Access point supports a group 104-bit WEP cipher *)
+    | `Group_tkip
+        (** Access point supports a group TKIP cipher *)
+    | `Group_ccmp
+        (** Access point supports a group CCMP cipher *)
+    | `Key_mgmt_psk
+        (** Access point supports PSK key management *)
+    | `Key_mgmt_802_1x
+        (** Access point supports 802.1x key management *) ]
+
+val wpa_flags : t -> ap_security_flag list OBus_property.r
+val rsn_flags : t -> ap_security_flag list OBus_property.r
+
+val ssid : t -> string OBus_property.r
+
+val frequency : t -> int OBus_property.r
+val hw_address : t -> string OBus_property.r
+val mode : t -> int OBus_property.r
+val max_bitrate : t -> int OBus_property.r
+val strength : t -> int OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_connection.ml b/bindings/network-manager/nm_connection.ml
new file mode 100644
index 0000000..dc23ea1
--- /dev/null
+++ b/bindings/network-manager/nm_connection.ml
@@ -0,0 +1,67 @@
+(*
+ * nm_connection.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+open Lwt
+
+let section = Lwt_log.Section.make "network-manager(connection)"
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_Connection_Active
+
+type state =
+    [ `Unknown
+    | `Activating
+    | `Activated ]
+
+let service_name proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_ServiceName proxy
+
+let connection proxy =
+  OBus_property.map_r_with_context
+    (fun context x ->
+       Nm_settings.Connection.of_proxy
+         (OBus_proxy.make (OBus_context.sender context) x))
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Connection proxy)
+
+let specific_object proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_SpecificObject proxy)
+
+let devices proxy =
+  OBus_property.map_r_with_context
+    (fun context paths ->
+       List.map
+         (fun path ->
+            Nm_device.of_proxy
+              (OBus_proxy.make (OBus_context.sender context) path))
+         paths)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Devices proxy)
+
+let state proxy =
+  OBus_property.map_r
+    (function
+       | 0l -> `Unknown
+       | 1l -> `Activating
+       | 2l -> `Activated
+       | st ->
+           ignore (Lwt_log.warning_f ~section "Nm_connection.state: unknown state: %ld" st);
+           `Unknown)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy)
+
+let default proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Default proxy
+
+let vpn proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Vpn proxy
+
+let properties_changed proxy =
+  OBus_signal.make s_PropertiesChanged proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
diff --git a/bindings/network-manager/nm_connection.mli b/bindings/network-manager/nm_connection.mli
new file mode 100644
index 0000000..fd3bce8
--- /dev/null
+++ b/bindings/network-manager/nm_connection.mli
@@ -0,0 +1,40 @@
+(*
+ * nm_connection.mli
+ * -----------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** NetworkManager active connections *)
+
+(** An active connection is a connection that is currently being used *)
+
+include OBus_proxy.Private
+
+(** The connection state *)
+type state =
+    [ `Unknown
+        (** The active connection is in an unknown state. *)
+    | `Activating
+        (** The connection is activating. *)
+    | `Activated
+        (** The connection is activated. *) ]
+
+(** {6 Signals} *)
+
+val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+(** {6 Properties} *)
+
+val service_name : t -> string OBus_property.r
+val connection : t -> Nm_settings.Connection.t OBus_property.r
+val specific_object : t -> OBus_proxy.t OBus_property.r
+val devices : t -> Nm_device.t list OBus_property.r
+val state : t -> state OBus_property.r
+val default : t -> bool OBus_property.r
+val vpn : t -> bool OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_device.ml b/bindings/network-manager/nm_device.ml
new file mode 100644
index 0000000..1c00a45
--- /dev/null
+++ b/bindings/network-manager/nm_device.ml
@@ -0,0 +1,389 @@
+(*
+ * nm_device.ml
+ * ------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+open Lwt
+
+let section = Lwt_log.Section.make "network-manager(device)"
+
+include OBus_proxy.Private
+
+type state =
+    [ `Unknown
+    | `Unmanaged
+    | `Unavailable
+    | `Disconnected
+    | `Prepare
+    | `Config
+    | `Need_auth
+    | `Ip_config
+    | `Activated
+    | `Failed ]
+
+type state_reason =
+    [ `Unknown
+    | `None
+    | `Now_managed
+    | `Now_unmanaged
+    | `Config_failed
+    | `Config_unavailable
+    | `Config_expired
+    | `No_secrets
+    | `Supplicant_disconnect
+    | `Supplicant_config_failed
+    | `Supplicant_failed
+    | `Supplicant_timeout
+    | `Ppp_start_failed
+    | `Ppp_disconnect
+    | `Ppp_failed
+    | `Dhcp_start_failed
+    | `Dhcp_error
+    | `Dhcp_failed
+    | `Shared_start_failed
+    | `Shared_failed
+    | `Autoip_start_failed
+    | `Autoip_error
+    | `Autoip_failed
+    | `Modem_busy
+    | `Modem_no_dial_tone
+    | `Modem_no_carrier
+    | `Modem_dial_timeout
+    | `Modem_dial_failed
+    | `Modem_init_failed
+    | `Gsm_apn_failed
+    | `Gsm_registration_not_searching
+    | `Gsm_registration_denied
+    | `Gsm_registration_timeout
+    | `Gsm_registration_failed
+    | `Gsm_pin_check_failed
+    | `Firmware_missing
+    | `Removed
+    | `Sleeping
+    | `Connection_removed
+    | `User_requested
+    | `Carrier
+    | `Connection_assumed
+    | `Supplicant_available ]
+
+type typ =
+  [ `Unknown
+  | `Ethernet
+  | `Wifi
+  | `Gsm
+  | `Cdma ]
+
+type capability =
+  [ `Nm_supported
+  | `Carrier_detect ]
+
+let state_of_int32 = function
+  | 0l -> `Unknown
+  | 1l -> `Unmanaged
+  | 2l -> `Unavailable
+  | 3l -> `Disconnected
+  | 4l -> `Prepare
+  | 5l -> `Config
+  | 6l -> `Need_auth
+  | 7l -> `Ip_config
+  | 8l -> `Activated
+  | 9l -> `Failed
+  | st ->
+      ignore (Lwt_log.warning_f ~section "Nm_device.state_of_int32: unknown device_state: %ld" st);
+      `Unknown
+
+let state_reason_of_int32 = function
+  | 0l -> `Unknown
+  | 1l -> `None
+  | 2l -> `Now_managed
+  | 3l -> `Now_unmanaged
+  | 4l -> `Config_failed
+  | 5l -> `Config_unavailable
+  | 6l -> `Config_expired
+  | 7l -> `No_secrets
+  | 8l -> `Supplicant_disconnect
+  | 9l -> `Supplicant_config_failed
+  | 10l -> `Supplicant_failed
+  | 11l -> `Supplicant_timeout
+  | 12l -> `Ppp_start_failed
+  | 13l -> `Ppp_disconnect
+  | 14l -> `Ppp_failed
+  | 15l -> `Dhcp_start_failed
+  | 16l -> `Dhcp_error
+  | 17l -> `Dhcp_failed
+  | 18l -> `Shared_start_failed
+  | 19l -> `Shared_failed
+  | 20l -> `Autoip_start_failed
+  | 21l -> `Autoip_error
+  | 22l -> `Autoip_failed
+  | 23l -> `Modem_busy
+  | 24l -> `Modem_no_dial_tone
+  | 25l -> `Modem_no_carrier
+  | 26l -> `Modem_dial_timeout
+  | 27l -> `Modem_dial_failed
+  | 28l -> `Modem_init_failed
+  | 29l -> `Gsm_apn_failed
+  | 30l -> `Gsm_registration_not_searching
+  | 31l -> `Gsm_registration_denied
+  | 32l -> `Gsm_registration_timeout
+  | 33l -> `Gsm_registration_failed
+  | 34l -> `Gsm_pin_check_failed
+  | 35l -> `Firmware_missing
+  | 36l -> `Removed
+  | 37l -> `Sleeping
+  | 38l -> `Connection_removed
+  | 39l -> `User_requested
+  | 40l -> `Carrier
+  | 41l -> `Connection_assumed
+  | 42l -> `Supplicant_available
+  | n ->
+      ignore (Lwt_log.warning_f ~section "Nm_device.state_reason_of_int32: unknown state_reason: %ld" n);
+      `Unknown
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_Device
+
+let udi proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Udi proxy
+
+let interface proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Interface proxy
+
+let driver proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Driver proxy
+
+let capabilities proxy =
+  OBus_property.map_r
+    (fun n ->
+       let n = Int32.to_int n in
+       let l = [] in
+       let l = if n land 0x1 <> 0 then `Nm_supported :: l else l in
+       let l = if n land 0x2 <> 0 then `Carrier_detect :: l else l in
+       l)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Capabilities proxy)
+
+let ip4_address proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Ip4Address proxy
+
+let state proxy =
+  OBus_property.map_r
+    state_of_int32
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy)
+
+let ip4_config proxy =
+  OBus_property.map_r_with_context
+    (fun context path ->
+       Nm_ip4_config.of_proxy
+         (OBus_proxy.make (OBus_context.sender context) path))
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Ip4Config proxy)
+
+let dhcp4_config proxy =
+  OBus_property.map_r_with_context
+    (fun context path ->
+       Nm_dhcp4_config.of_proxy
+         (OBus_proxy.make (OBus_context.sender context) path))
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Dhcp4Config proxy)
+
+let ip6_config proxy =
+  OBus_property.map_r_with_context
+    (fun context path ->
+       Nm_ip6_config.of_proxy
+         (OBus_proxy.make (OBus_context.sender context) path))
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Ip6Config proxy)
+
+let managed proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Managed proxy
+
+let device_type proxy =
+  OBus_property.map_r
+    (function
+       | 0l -> `Unknown
+       | 1l -> `Ethernet
+       | 2l -> `Wifi
+       | 3l -> `Gsm
+       | 4l -> `Cdma
+       | n ->
+           ignore (Lwt_log.warning_f ~section "device_type_of_int: unknown type: %ld" n);
+           `Unknown)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_DeviceType proxy)
+
+let disconnect proxy =
+  OBus_method.call m_Disconnect proxy ()
+
+let state_changed proxy =
+  OBus_signal.map
+    (fun (new_state, old_state, reason) ->
+       (state_of_int32 new_state,
+        state_of_int32 old_state,
+        state_reason_of_int32 reason))
+    (OBus_signal.make s_StateChanged proxy)
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy Nm_interfaces.Org_freedesktop_NetworkManager_Device.interface
+
+module Bluetooth =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Bluetooth
+
+  let hw_address proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy
+
+  let name proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_Name proxy
+
+  let bt_capabilities proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_BtCapabilities proxy)
+
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+
+  let properties proxy =
+    OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
+end
+
+module Cdma =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Cdma
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+end
+
+module Gsm =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Gsm
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+end
+
+module Olpc_mesh =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_OlpcMesh
+
+  let hw_address proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy
+
+  let companion proxy =
+    OBus_property.map_r_with_context
+      (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_Companion proxy)
+
+  let active_channel proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveChannel proxy)
+
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+
+  let properties proxy =
+    OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
+end
+
+module Serial =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Serial
+
+  let ppp_stats proxy =
+    OBus_signal.map
+      (fun (in_bytes, out_bytes) ->
+         let in_bytes = Int32.to_int in_bytes in
+         let out_bytes = Int32.to_int out_bytes in
+         (in_bytes, out_bytes))
+      (OBus_signal.make s_PppStats proxy)
+end
+
+module Wired =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Wired
+
+  let hw_address proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy
+
+  let speed proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_Speed proxy)
+
+  let carrier proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_Carrier proxy
+
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+
+  let properties proxy =
+    OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
+end
+
+module Wireless =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Wireless
+
+  type wireless_capability =
+      [ `Cipher_wep40
+      | `Cipher_wep104
+      | `Cipher_tkip
+      | `Cipher_ccmp
+      | `Wpa
+      | `Rsn ]
+
+  type wifi_mode =
+      [ `Unknown
+      | `Adhoc
+      | `Infra ]
+
+  let get_access_points proxy =
+    let%lwt (context, access_points) = OBus_method.call_with_context m_GetAccessPoints proxy () in
+    return (
+      List.map
+        (fun path ->
+           Nm_access_point.of_proxy
+             (OBus_proxy.make (OBus_context.sender context) path))
+        access_points
+    )
+
+  let hw_address proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy
+
+  let mode proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_Mode proxy)
+
+  let bitrate proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_Bitrate proxy)
+
+  let active_access_point proxy =
+    OBus_property.map_r_with_context
+      (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveAccessPoint proxy)
+
+  let wireless_capabilities proxy =
+    OBus_property.map_r
+      (fun x -> Int32.to_int x)
+      (OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessCapabilities proxy)
+
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+
+  let access_point_added proxy =
+    OBus_signal.map_with_context
+      (fun context access_point ->
+         Nm_access_point.of_proxy
+           (OBus_proxy.make (OBus_context.sender context) access_point))
+      (OBus_signal.make s_AccessPointAdded proxy)
+
+  let access_point_removed proxy =
+    OBus_signal.map_with_context
+      (fun context access_point ->
+         Nm_access_point.of_proxy
+           (OBus_proxy.make (OBus_context.sender context) access_point))
+      (OBus_signal.make s_AccessPointRemoved proxy)
+
+  let properties proxy =
+    OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
+end
diff --git a/bindings/network-manager/nm_device.mli b/bindings/network-manager/nm_device.mli
new file mode 100644
index 0000000..dd78035
--- /dev/null
+++ b/bindings/network-manager/nm_device.mli
@@ -0,0 +1,251 @@
+(*
+ * nm_device.mli
+ * -------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** NetworkManager devices *)
+
+include OBus_proxy.Private
+
+(** {6 Common interface} *)
+
+(** {8 Types} *)
+
+type state =
+    [ `Unknown
+	(** The device is in an unknown state. *)
+    | `Unmanaged
+	(** The device is not managed by NetworkManager. *)
+    | `Unavailable
+	(** The device cannot be used (carrier off, rfkill, etc)  *)
+    | `Disconnected
+	(** The device is not connected. *)
+    | `Prepare
+	(** The device is preparing to connect. *)
+    | `Config
+	(** The device is being configured. *)
+    | `Need_auth
+	(** The device is awaiting secrets necessary to continue connection. *)
+    | `Ip_config
+	(** The IP settings of the device are being requested and configured. *)
+    | `Activated
+	(** The device is active. *)
+    | `Failed
+	(** The device is in a failure state following an attempt to activate it. *) ]
+
+type state_reason =
+    [ `Unknown
+	(** The reason for the device state change is unknown. *)
+    | `None
+	(** The state change is normal. *)
+    | `Now_managed
+	(** The device is now managed. *)
+    | `Now_unmanaged
+	(** The device is no longer managed. *)
+    | `Config_failed
+	(** The device could not be readied for configuration. *)
+    | `Config_unavailable
+	(** IP configuration could not be reserved (no available address, timeout, etc). *)
+    | `Config_expired
+	(** The IP configuration is no longer valid. *)
+    | `No_secrets
+	(** Secrets were required, but not provided. *)
+    | `Supplicant_disconnect
+	(** The 802.1X supplicant disconnected from the access point or authentication server. *)
+    | `Supplicant_config_failed
+	(** Configuration of the 802.1X supplicant failed. *)
+    | `Supplicant_failed
+	(** The 802.1X supplicant quit or failed unexpectedly. *)
+    | `Supplicant_timeout
+	(** The 802.1X supplicant took too long to authenticate. *)
+    | `Ppp_start_failed
+	(** The PPP service failed to start within the allowed time. *)
+    | `Ppp_disconnect
+	(** The PPP service disconnected unexpectedly. *)
+    | `Ppp_failed
+	(** The PPP service quit or failed unexpectedly. *)
+    | `Dhcp_start_failed
+	(** The DHCP service failed to start within the allowed time. *)
+    | `Dhcp_error
+	(** The DHCP service reported an unexpected error. *)
+    | `Dhcp_failed
+	(** The DHCP service quit or failed unexpectedly. *)
+    | `Shared_start_failed
+	(** The shared connection service failed to start. *)
+    | `Shared_failed
+	(** The shared connection service quit or failed unexpectedly. *)
+    | `Autoip_start_failed
+	(** The AutoIP service failed to start. *)
+    | `Autoip_error
+	(** The AutoIP service reported an unexpected error. *)
+    | `Autoip_failed
+	(** The AutoIP service quit or failed unexpectedly. *)
+    | `Modem_busy
+	(** Dialing failed because the line was busy. *)
+    | `Modem_no_dial_tone
+	(** Dialing failed because there was no dial tone. *)
+    | `Modem_no_carrier
+	(** Dialing failed because there was carrier. *)
+    | `Modem_dial_timeout
+	(** Dialing timed out. *)
+    | `Modem_dial_failed
+	(** Dialing failed. *)
+    | `Modem_init_failed
+	(** Modem initialization failed. *)
+    | `Gsm_apn_failed
+	(** Failed to select the specified GSM APN. *)
+    | `Gsm_registration_not_searching
+	(** Not searching for networks. *)
+    | `Gsm_registration_denied
+	(** Network registration was denied. *)
+    | `Gsm_registration_timeout
+	(** Network registration timed out. *)
+    | `Gsm_registration_failed
+	(** Failed to register with the requested GSM network. *)
+    | `Gsm_pin_check_failed
+	(** PIN check failed. *)
+    | `Firmware_missing
+	(** Necessary firmware for the device may be missing. *)
+    | `Removed
+	(** The device was removed. *)
+    | `Sleeping
+	(** NetworkManager went to sleep. *)
+    | `Connection_removed
+	(** The device's active connection was removed or disappeared. *)
+    | `User_requested
+	(** A user or client requested the disconnection. *)
+    | `Carrier
+	(** The device's carrier/link changed. *)
+    | `Connection_assumed
+	(** The device's existing connection was assumed. *)
+    | `Supplicant_available
+	(** The 802.1x supplicant is now available. *) ]
+
+type typ =
+  [ `Unknown
+      (** The device type is unknown. *)
+  | `Ethernet
+      (** The device is wired Ethernet device. *)
+  | `Wifi
+      (** The device is an 802.11 WiFi device. *)
+  | `Gsm
+      (** The device is a GSM-based cellular WAN device. *)
+  | `Cdma
+      (** The device is a CDMA/IS-95-based cellular WAN device. *) ]
+
+type capability =
+  [ `Nm_supported
+      (** The device is supported by NetworkManager. *)
+  | `Carrier_detect
+      (** The device supports carrier detection. *) ]
+
+(** {8 Methods} *)
+
+val disconnect : t -> unit Lwt.t
+
+(** {8 Signals} *)
+
+val state_changed : t -> (state * state * state_reason) OBus_signal.t
+
+(** {8 Properties} *)
+
+val udi : t -> string OBus_property.r
+val interface : t -> string OBus_property.r
+val driver : t -> string OBus_property.r
+val capabilities : t -> capability list OBus_property.r
+val ip4_address : t -> int32 OBus_property.r
+val state : t -> state OBus_property.r
+val ip4_config : t -> Nm_ip4_config.t OBus_property.r
+val dhcp4_config : t -> Nm_dhcp4_config.t OBus_property.r
+val ip6_config : t -> Nm_ip6_config.t OBus_property.r
+val managed : t -> bool OBus_property.r
+val device_type : t -> typ OBus_property.r
+
+val properties : t -> OBus_property.group
+
+(** {6 Specific device interfaces} *)
+
+module Bluetooth : sig
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+  val hw_address : t -> string OBus_property.r
+  val name : t -> string OBus_property.r
+  val bt_capabilities : t -> int OBus_property.r
+
+  val properties : t -> OBus_property.group
+end
+
+module Cdma : sig
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+end
+
+module Gsm : sig
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+end
+
+module Olpc_mesh : sig
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+  val hw_address : OBus_proxy.t -> (string, [ `readable ]) OBus_property.t
+  val companion : OBus_proxy.t -> (OBus_proxy.t, [ `readable ]) OBus_property.t
+  val active_channel : OBus_proxy.t -> (int, [ `readable ]) OBus_property.t
+
+  val properties : t -> OBus_property.group
+end
+
+module Serial : sig
+  val ppp_stats : t -> (int * int) OBus_signal.t
+end
+
+module Wired : sig
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+  val hw_address : t -> string OBus_property.r
+  val speed : t -> int OBus_property.r
+  val carrier : t -> bool OBus_property.r
+
+  val properties : t -> OBus_property.group
+end
+
+module Wireless : sig
+  type wireless_capability =
+      [ `Cipher_wep40
+          (** The device supports the 40-bit WEP cipher. *)
+      | `Cipher_wep104
+          (** The device supports the 104-bit WEP cipher. *)
+      | `Cipher_tkip
+          (** The device supports the TKIP cipher. *)
+      | `Cipher_ccmp
+          (** The device supports the CCMP cipher. *)
+      | `Wpa
+          (** The device supports the WPA encryption/authentication protocol. *)
+      | `Rsn
+          (** The device supports the RSN encryption/authentication protocol. *) ]
+
+  type wifi_mode =
+      [ `Unknown
+          (** Mode is unknown. *)
+      | `Adhoc
+          (** Uncoordinated network without central infrastructure. *)
+      | `Infra
+          (** Coordinated network with one or more central controllers. *) ]
+
+  val get_access_points : t -> Nm_access_point.t list Lwt.t
+
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+  val access_point_added : t -> Nm_access_point.t OBus_signal.t
+  val access_point_removed : t -> Nm_access_point.t OBus_signal.t
+
+  val hw_address : t -> string OBus_property.r
+  val mode : t -> int OBus_property.r
+  val bitrate : t -> int OBus_property.r
+  val active_access_point : t -> OBus_proxy.t OBus_property.r
+  val wireless_capabilities : t -> int OBus_property.r
+
+  val properties : t -> OBus_property.group
+end
diff --git a/bindings/network-manager/nm_dhcp4_config.ml b/bindings/network-manager/nm_dhcp4_config.ml
new file mode 100644
index 0000000..757fc4a
--- /dev/null
+++ b/bindings/network-manager/nm_dhcp4_config.ml
@@ -0,0 +1,16 @@
+(*
+ * nm_dhcp4_config.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_DHCP4Config
+
+let options proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Options proxy
+
+let properties_changed proxy =
+  OBus_signal.make s_PropertiesChanged proxy
diff --git a/bindings/network-manager/nm_dhcp4_config.mli b/bindings/network-manager/nm_dhcp4_config.mli
new file mode 100644
index 0000000..6919383
--- /dev/null
+++ b/bindings/network-manager/nm_dhcp4_config.mli
@@ -0,0 +1,15 @@
+(*
+ * nm_dhcp4_config.mli
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** DHCP4 configuration *)
+
+include OBus_proxy.Private
+
+val options : t -> (string * OBus_value.V.single) list OBus_property.r
+val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
diff --git a/bindings/network-manager/nm_interfaces.obus b/bindings/network-manager/nm_interfaces.obus
new file mode 100644
index 0000000..ccbd6ec
--- /dev/null
+++ b/bindings/network-manager/nm_interfaces.obus
@@ -0,0 +1,183 @@
+(*
+ * nm_interfaces.obus
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.NetworkManager {
+  method GetDevices : () -> (devices : object_path array)
+  method ActivateConnection : (service_name : string, connection : object_path, device : object_path, specific_object : object_path) -> (active_connection : object_path)
+  method DeactivateConnection : (active_connection : object_path) -> ()
+  method Sleep : (sleep : boolean) -> ()
+  property_rw WirelessEnabled : boolean
+  property_r WirelessHardwareEnabled : boolean
+  property_rw WwanEnabled : boolean
+  property_r WwanHardwareEnabled : boolean
+  property_r ActiveConnections : object_path array
+  property_r State : uint32
+  signal StateChanged : (state : uint32)
+  signal PropertiesChanged : (properties : (string, variant) dict)
+  signal DeviceAdded : (state : object_path)
+  signal DeviceRemoved : (state : object_path)
+}
+
+interface org.freedesktop.NetworkManager.AccessPoint {
+  property_r Flags : uint32
+  property_r WpaFlags : uint32
+  property_r RsnFlags : uint32
+  property_r Ssid : byte array
+  property_r Frequency : uint32
+  property_r HwAddress : string
+  property_r Mode : uint32
+  property_r MaxBitrate : uint32
+  property_r Strength : byte
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Connection.Active {
+  property_r ServiceName : string
+  property_r Connection : object_path
+  property_r SpecificObject : object_path
+  property_r Devices : object_path array
+  property_r State : uint32
+  property_r Default : boolean
+  property_r Vpn : boolean
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.DHCP4Config {
+  property_r Options : (string, variant) dict
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device {
+  property_r Udi : string
+  property_r Interface : string
+  property_r Driver : string
+  property_r Capabilities : uint32
+  property_r Ip4Address : uint32
+  property_r State : uint32
+  property_r Ip4Config : object_path
+  property_r Dhcp4Config : object_path
+  property_r Ip6Config : object_path
+  property_r Managed : boolean
+  property_r DeviceType : uint32
+  method Disconnect : () -> ()
+  signal StateChanged : (new_state : uint32, old_state : uint32, reason : uint32)
+}
+
+interface org.freedesktop.NetworkManager.Device.Bluetooth {
+  property_r HwAddress : string
+  property_r Name : string
+  property_r BtCapabilities : uint32
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device.Cdma {
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device.Gsm {
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device.OlpcMesh {
+  property_r HwAddress : string
+  property_r Companion : object_path
+  property_r ActiveChannel : uint32
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device.Serial {
+  signal PppStats : (in_bytes : uint32, out_bytes : uint32)
+}
+
+interface org.freedesktop.NetworkManager.Device.Wired {
+  property_r HwAddress : string
+  property_r Speed : uint32
+  property_r Carrier : boolean
+  signal PropertiesChanged : (properties : (string, variant) dict)
+}
+
+interface org.freedesktop.NetworkManager.Device.Wireless {
+  method GetAccessPoints : () -> (access_points : object_path array)
+  property_r HwAddress : string
+  property_r Mode : uint32
+  property_r Bitrate : uint32
+  property_r ActiveAccessPoint : object_path
+  property_r WirelessCapabilities : uint32
+  signal PropertiesChanged : (properties : (string, variant) dict)
+  signal AccessPointAdded : (access_point : object_path)
+  signal AccessPointRemoved : (access_point : object_path)
+}
+
+interface org.freedesktop.NetworkManager.IP4Config {
+  property_r Addresses : (uint32 array) array
+  property_r Nameservers : uint32 array
+  property_r WinsServers : uint32 array
+  property_r Domains : string array
+  property_r Routes : (uint32 array) array
+}
+
+interface org.freedesktop.NetworkManager.IP6Config {
+  property_r Addresses : (byte array * uint32) array
+  property_r Nameservers : (byte array) array
+  property_r Domains : string array
+  property_r Routes : (byte array * uint32 * byte array * uint32) array
+}
+
+interface org.freedesktop.NetworkManager.PPP {
+  method NeedSecrets : () -> (username : string, password : string)
+  method SetIp4Config : (config : (string, variant) dict) -> ()
+  method SetState : (state : uint32) -> ()
+}
+
+interface org.freedesktop.NetworkManager.VPN.Connection {
+  signal PropertiesChanged : (properties : (string, variant) dict)
+  property_r VpnState : uint32
+  property_r Banner : string
+  signal VpnStateChanged : (state : uint32, reason : uint32)
+}
+
+interface org.freedesktop.NetworkManager.VPN.Plugin {
+  method Connect : (connection : (string, (string, variant) dict) dict) -> ()
+  method NeedSecrets : (settings : (string, (string, variant) dict) dict) -> (setting_name : string)
+  method Disconnect : () -> ()
+  method SetIp4Config : (config : (string, variant) dict) -> ()
+  method SetFailure : (reason : string) -> ()
+  property_r State : uint32
+  signal StateChanged : (state : uint32)
+  signal Ip4Config : (ip4config : (string, variant) dict)
+  signal LoginBanner : (banner : string)
+  signal Failure : (reason : uint32)
+}
+
+interface org.freedesktop.NetworkManagerSettings {
+  method ListConnections : () -> (connections : object_path array)
+  method AddConnection : (connection : (string, (string, variant) dict) dict) -> ()
+  signal NewConnection : (connection : object_path)
+}
+
+interface org.freedesktop.NetworkManagerSettings.Connection {
+  method Update : (properties : (string, (string, variant) dict) dict) -> ()
+  method Delete : () -> ()
+  method GetSettings : () -> (settings : (string, (string, variant) dict) dict)
+  signal Updated : (settings : (string, (string, variant) dict) dict)
+  signal Removed : ()
+}
+
+interface org.freedesktop.NetworkManagerSettings.Connection.Secrets {
+  method GetSecrets : (setting_name : string, hints : string array, request_new : boolean) -> (secrets : (string, (string, variant) dict) dict)
+}
+
+interface org.freedesktop.NetworkManagerSettings.System {
+  method SaveHostname : (hostname : string) -> ()
+  property_r Hostname : string
+  property_r CanModify : boolean
+  signal PropertiesChanged : (properties : (string, variant) dict)
+  signal CheckPermissions : ()
+  method GetPermissions : () -> (permissions : uint32)
+}
diff --git a/bindings/network-manager/nm_ip4_config.ml b/bindings/network-manager/nm_ip4_config.ml
new file mode 100644
index 0000000..d6dd30d
--- /dev/null
+++ b/bindings/network-manager/nm_ip4_config.ml
@@ -0,0 +1,36 @@
+(*
+ * nm_ip4_config.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_IP4Config
+
+let addresses proxy =
+  OBus_property.map_r
+    (fun x -> List.map (List.map Int32.to_int) x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy)
+
+let nameservers proxy =
+  OBus_property.map_r
+    (fun x -> List.map Int32.to_int x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy)
+
+let wins_servers proxy =
+  OBus_property.map_r
+    (fun x -> List.map Int32.to_int x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_WinsServers proxy)
+
+let domains proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy
+
+let routes proxy =
+  OBus_property.map_r
+    (fun x -> List.map (List.map Int32.to_int) x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy)
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
diff --git a/bindings/network-manager/nm_ip4_config.mli b/bindings/network-manager/nm_ip4_config.mli
new file mode 100644
index 0000000..26bbd6d
--- /dev/null
+++ b/bindings/network-manager/nm_ip4_config.mli
@@ -0,0 +1,20 @@
+(*
+ * nm_ip4_config.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Ip4 configuration *)
+
+include OBus_proxy.Private
+
+val addresses : t -> int list list OBus_property.r
+val nameservers : t -> int list OBus_property.r
+val wins_servers : t -> int list OBus_property.r
+val domains : t -> string list OBus_property.r
+val routes : t -> int list list OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_ip6_config.ml b/bindings/network-manager/nm_ip6_config.ml
new file mode 100644
index 0000000..d2ccf11
--- /dev/null
+++ b/bindings/network-manager/nm_ip6_config.ml
@@ -0,0 +1,29 @@
+(*
+ * nm_ip6_config.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_IP6Config
+
+let addresses proxy =
+  OBus_property.map_r
+    (fun x -> List.map (fun (x1, x2) -> (x1, Int32.to_int x2)) x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy)
+
+let nameservers proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy
+
+let domains proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy
+
+let routes proxy =
+  OBus_property.map_r
+    (fun x -> List.map (fun (x1, x2, x3, x4) -> (x1, Int32.to_int x2, x3, Int32.to_int x4)) x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy)
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
diff --git a/bindings/network-manager/nm_ip6_config.mli b/bindings/network-manager/nm_ip6_config.mli
new file mode 100644
index 0000000..2238880
--- /dev/null
+++ b/bindings/network-manager/nm_ip6_config.mli
@@ -0,0 +1,19 @@
+(*
+ * nm_ip6_config.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Ip6 configuration *)
+
+include OBus_proxy.Private
+
+val addresses : t -> (string * int) list OBus_property.r
+val nameservers : t -> string list OBus_property.r
+val domains : t -> string list OBus_property.r
+val routes : t -> (string * int * string * int) list OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_manager.ml b/bindings/network-manager/nm_manager.ml
new file mode 100644
index 0000000..134ef9d
--- /dev/null
+++ b/bindings/network-manager/nm_manager.ml
@@ -0,0 +1,128 @@
+(*
+ * nm_manager.ml
+ * -------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+let section = Lwt_log.Section.make "network-manager"
+
+include OBus_peer.Private
+
+let daemon () =
+  let%lwt bus = OBus_bus.system () in
+  Lwt.return (OBus_peer.make bus "org.freedesktop.NetworkManager")
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+type state =
+  [ `Unknown
+  | `Asleep
+  | `Connecting
+  | `Connected
+  | `Disconnected ]
+
+let state_of_int32 = function
+  | 0l -> `Unknown
+  | 1l -> `Asleep
+  | 2l -> `Connecting
+  | 3l -> `Connected
+  | 4l -> `Disconnected
+  | i -> ignore (Lwt_log.warning_f ~section "Nm_manager.state_of_int32: unknown state: %ld" i); `Unknown
+
+(* +-----------------------------------------------------------------+
+   | D-Bus definitions                                               |
+   +-----------------------------------------------------------------+ *)
+
+let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "NetworkManager"]
+
+open Nm_interfaces.Org_freedesktop_NetworkManager
+
+let get_devices daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_GetDevices (proxy daemon) () in
+  return (
+    List.map
+      (fun path ->
+         Nm_device.of_proxy
+           (OBus_proxy.make (OBus_context.sender context) path))
+      devices
+  )
+
+let activate_connection daemon ~service_name ~connection ~device ~specific_object =
+  let connection = OBus_proxy.path (Nm_settings.Connection.to_proxy connection) in
+  let device = OBus_proxy.path (Nm_device.to_proxy device) in
+  let specific_object = OBus_proxy.path specific_object in
+  let%lwt (context, active_connection) =
+    OBus_method.call_with_context
+      m_ActivateConnection
+      (proxy daemon)
+      (service_name, connection, device, specific_object)
+  in
+  return (
+    Nm_connection.of_proxy
+      (OBus_proxy.make (OBus_context.sender context) active_connection)
+  )
+
+let deactivate_connection daemon ~active_connection =
+  let active_connection = OBus_proxy.path (Nm_connection.to_proxy active_connection) in
+  OBus_method.call m_DeactivateConnection (proxy daemon) active_connection
+
+let sleep daemon ~sleep =
+  OBus_method.call m_Sleep (proxy daemon) sleep
+
+let wireless_enabled daemon =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessEnabled (proxy daemon)
+
+let wireless_hardware_enabled daemon =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessHardwareEnabled (proxy daemon)
+
+let wwan_enabled daemon =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_WwanEnabled (proxy daemon)
+
+let wwan_hardware_enabled daemon =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_WwanHardwareEnabled (proxy daemon)
+
+let active_connections daemon =
+  OBus_property.map_r_with_context
+    (fun context paths ->
+       List.map
+         (fun path ->
+            Nm_connection.of_proxy
+              (OBus_proxy.make (OBus_context.sender context) path))
+         paths)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveConnections (proxy daemon))
+
+let state daemon =
+  OBus_property.map_r
+    state_of_int32
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_State (proxy daemon))
+
+let state_changed daemon =
+  OBus_signal.map
+    state_of_int32
+    (OBus_signal.make s_StateChanged (proxy daemon))
+
+let properties_changed daemon =
+  OBus_signal.make s_PropertiesChanged (proxy daemon)
+
+let device_added daemon =
+  OBus_signal.map_with_context
+    (fun context state ->
+       Nm_device.of_proxy (OBus_proxy.make (OBus_context.sender context) state))
+    (OBus_signal.make s_DeviceAdded (proxy daemon))
+
+let device_removed daemon =
+  OBus_signal.map_with_context
+    (fun context state ->
+       Nm_device.of_proxy (OBus_proxy.make (OBus_context.sender context) state))
+    (OBus_signal.make s_DeviceRemoved (proxy daemon))
+
+let properties daemon =
+  OBus_property.group ~monitor:Nm_monitor.monitor (proxy daemon) interface
diff --git a/bindings/network-manager/nm_manager.mli b/bindings/network-manager/nm_manager.mli
new file mode 100644
index 0000000..1c72201
--- /dev/null
+++ b/bindings/network-manager/nm_manager.mli
@@ -0,0 +1,62 @@
+(*
+ * nm_manager.mli
+ * --------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** NetworkManager main interface *)
+
+include OBus_peer.Private
+
+val daemon : unit -> t Lwt.t
+  (** [daemon ()] returns the peer object for the network manager daemon *)
+
+(** {6 Types} *)
+
+(** State of the daemon *)
+type state =
+  [ `Unknown
+      (** The NetworkManager daemon is in an unknown state. *)
+  | `Asleep
+      (** The NetworkManager daemon is asleep and all interfaces
+	  managed by it are inactive. *)
+  | `Connecting
+      (** The NetworkManager daemon is connecting a device. *)
+  | `Connected
+      (** The NetworkManager daemon is connected. *)
+  | `Disconnected
+      (** The NetworkManager daemon is disconnected. *) ]
+
+(** {6 Methods} *)
+
+val get_devices : t -> Nm_device.t list Lwt.t
+val activate_connection : t ->
+  service_name : OBus_name.bus ->
+  connection : Nm_settings.Connection.t ->
+  device : Nm_device.t ->
+  specific_object : OBus_proxy.t ->
+  Nm_connection.t Lwt.t
+val deactivate_connection : t -> active_connection : Nm_connection.t -> unit Lwt.t
+val sleep : t -> sleep : bool -> unit Lwt.t
+
+(** {6 Signals} *)
+
+val state_changed : t -> state OBus_signal.t
+val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+val device_added : t -> Nm_device.t OBus_signal.t
+val device_removed : t -> Nm_device.t OBus_signal.t
+
+(** {6 Properties} *)
+
+val wireless_enabled : t -> bool OBus_property.rw
+val wireless_hardware_enabled : t -> bool OBus_property.r
+val wwan_enabled : t -> bool OBus_property.rw
+val wwan_hardware_enabled : t -> bool OBus_property.r
+val active_connections : t -> Nm_connection.t list OBus_property.r
+val state : t -> state OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_monitor.ml b/bindings/network-manager/nm_monitor.ml
new file mode 100644
index 0000000..11e34f0
--- /dev/null
+++ b/bindings/network-manager/nm_monitor.ml
@@ -0,0 +1,33 @@
+(*
+ * nm_monitor.ml
+ * -------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt_react
+open Lwt
+open OBus_value
+
+module String_map = Map.Make(String)
+
+let properties_changed interface =
+  OBus_member.Signal.make
+    ~interface
+    ~member:"PropertiesChanged"
+    ~args:(arg1 (Some "properties", C.dict C.string C.variant))
+    ~annotations:[]
+
+let monitor proxy interface switch =
+  let%lwt event =
+    OBus_signal.connect ~switch
+      (OBus_signal.with_context
+         (OBus_signal.make (properties_changed interface) proxy))
+  and context, dict = OBus_property.get_all_no_cache proxy interface in
+  return (S.fold_s ~eq:(String_map.equal (=))
+            (fun map (context, updates) ->
+               return (OBus_property.update_map context updates map))
+            (OBus_property.map_of_list context dict)
+            event)
diff --git a/bindings/network-manager/nm_monitor.mli b/bindings/network-manager/nm_monitor.mli
new file mode 100644
index 0000000..4fef481
--- /dev/null
+++ b/bindings/network-manager/nm_monitor.mli
@@ -0,0 +1,13 @@
+(*
+ * nm_monitor.mli
+ * --------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Properties monitoring *)
+
+val monitor : OBus_property.monitor
+  (** Monitor for properties of Network Manager interfaces. *)
diff --git a/bindings/network-manager/nm_ppp.ml b/bindings/network-manager/nm_ppp.ml
new file mode 100644
index 0000000..45b3c8a
--- /dev/null
+++ b/bindings/network-manager/nm_ppp.ml
@@ -0,0 +1,20 @@
+(*
+ * nm_ppp.ml
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_PPP
+
+let need_secrets proxy =
+  OBus_method.call m_NeedSecrets proxy ()
+
+let set_ip4_config proxy ~config =
+  OBus_method.call m_SetIp4Config proxy config
+
+let set_state proxy ~state =
+  let state = Int32.of_int state in
+  OBus_method.call m_SetState proxy state
diff --git a/bindings/network-manager/nm_ppp.mli b/bindings/network-manager/nm_ppp.mli
new file mode 100644
index 0000000..90ada8c
--- /dev/null
+++ b/bindings/network-manager/nm_ppp.mli
@@ -0,0 +1,16 @@
+(*
+ * nm_ppp.mli
+ * ----------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** PPP *)
+
+include OBus_proxy.Private
+
+val need_secrets : t -> (string * string) Lwt.t
+val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t
+val set_state : t -> state : int -> unit Lwt.t
diff --git a/bindings/network-manager/nm_settings.ml b/bindings/network-manager/nm_settings.ml
new file mode 100644
index 0000000..24a1a4c
--- /dev/null
+++ b/bindings/network-manager/nm_settings.ml
@@ -0,0 +1,98 @@
+(*
+ * nm_settings.ml
+ * --------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+open Lwt
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManagerSettings
+
+let user () =
+  let%lwt bus = OBus_bus.session () in
+  return (OBus_proxy.make
+            (OBus_peer.make bus "org.freedesktop.NetworkManagerUserSettings")
+            [ "org"; "freedesktop"; "NetworkManagerSettings" ])
+
+let system () =
+  let%lwt bus = OBus_bus.system () in
+  return (OBus_proxy.make
+            (OBus_peer.make bus "org.freedesktop.NetworkManagerSystemSettings")
+            [ "org"; "freedesktop"; "NetworkManagerSettings" ])
+
+module Connection =
+struct
+  include OBus_proxy.Private
+
+  open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection
+
+  let update proxy ~properties =
+    OBus_method.call m_Update proxy properties
+
+  let delete proxy =
+    OBus_method.call m_Delete proxy ()
+
+  let get_settings proxy =
+    OBus_method.call m_GetSettings proxy ()
+
+  let updated proxy =
+    OBus_signal.make s_Updated proxy
+
+  let removed proxy =
+    OBus_signal.make s_Removed proxy
+
+  module Secrets =
+  struct
+    open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection_Secrets
+
+    let get_secrets proxy ~setting_name ~hints ~request_new =
+      OBus_method.call m_GetSecrets proxy (setting_name, hints, request_new)
+  end
+end
+
+module System =
+struct
+  open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_System
+
+  let save_hostname proxy ~hostname =
+    OBus_method.call m_SaveHostname proxy hostname
+
+  let hostname proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_Hostname proxy
+
+  let can_modify proxy =
+    OBus_property.make ~monitor:Nm_monitor.monitor p_CanModify proxy
+
+  let properties_changed proxy =
+    OBus_signal.make s_PropertiesChanged proxy
+
+  let check_permissions proxy =
+    OBus_signal.make s_CheckPermissions proxy
+
+  let get_permissions proxy =
+    let%lwt permissions = OBus_method.call m_GetPermissions proxy () in
+    let permissions = Int32.to_int permissions in
+    return permissions
+end
+
+let list_connections proxy =
+  let%lwt (context, connections) = OBus_method.call_with_context m_ListConnections proxy () in
+  return (
+    List.map
+      (fun path ->
+         Connection.of_proxy
+           (OBus_proxy.make (OBus_context.sender context) path))
+      connections
+  )
+
+let add_connection proxy ~connection =
+  OBus_method.call m_AddConnection proxy connection
+
+let new_connection proxy =
+  OBus_signal.map_with_context
+    (fun context connection ->
+       Connection.of_proxy (OBus_proxy.make (OBus_context.sender context) connection))
+    (OBus_signal.make s_NewConnection proxy)
diff --git a/bindings/network-manager/nm_settings.mli b/bindings/network-manager/nm_settings.mli
new file mode 100644
index 0000000..acd3409
--- /dev/null
+++ b/bindings/network-manager/nm_settings.mli
@@ -0,0 +1,60 @@
+(*
+ * nm_settings.mli
+ * ---------------
+ * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org>
+ *                 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** NetworkManager settings *)
+
+include OBus_proxy.Private
+
+val user : unit -> t Lwt.t
+  (** [user ()] returns the proxy object for user settings. The object
+      is on the session message bus. *)
+
+val system : unit -> t Lwt.t
+  (** [system ()] returns the proxy object for system settings. The
+      object is on the system message bus *)
+
+(** Connection settings *)
+module Connection : sig
+  include OBus_proxy.Private
+
+  (** {6 Methods} *)
+
+  val update : t -> properties : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t
+  val delete : t -> unit Lwt.t
+  val get_settings : t -> (string * (string * OBus_value.V.single) list) list Lwt.t
+
+  (** {6 Signals} *)
+
+  val updated : t -> (string * (string * OBus_value.V.single) list) list OBus_signal.t
+  val removed : t -> unit OBus_signal.t
+
+  module Secrets : sig
+    val get_secrets : t -> setting_name : string -> hints : string list -> request_new : bool -> (string * (string * OBus_value.V.single) list) list Lwt.t
+  end
+end
+
+(** System settings *)
+module System : sig
+  val save_hostname : t -> hostname : string -> unit Lwt.t
+  val hostname : t -> string OBus_property.r
+  val can_modify : t -> bool OBus_property.r
+  val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+  val check_permissions : t -> unit OBus_signal.t
+  val get_permissions : t -> int Lwt.t
+end
+
+(** {6 Methods} *)
+
+val list_connections : t -> Connection.t list Lwt.t
+
+(** {6 Signals} *)
+
+val add_connection : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t
+val new_connection : t -> Connection.t OBus_signal.t
diff --git a/bindings/network-manager/nm_vpn_connection.ml b/bindings/network-manager/nm_vpn_connection.ml
new file mode 100644
index 0000000..aa41cd7
--- /dev/null
+++ b/bindings/network-manager/nm_vpn_connection.ml
@@ -0,0 +1,32 @@
+(*
+ * nm_vpn_connection.ml
+ * --------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Connection
+
+let properties_changed proxy =
+  OBus_signal.make s_PropertiesChanged proxy
+
+let vpn_state proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_VpnState proxy)
+
+let banner proxy =
+  OBus_property.make ~monitor:Nm_monitor.monitor p_Banner proxy
+
+let vpn_state_changed proxy =
+  OBus_signal.map
+    (fun (state, reason) ->
+       let state = Int32.to_int state in
+       let reason = Int32.to_int reason in
+       (state, reason))
+    (OBus_signal.make s_VpnStateChanged proxy)
+
+let properties proxy =
+  OBus_property.group ~monitor:Nm_monitor.monitor proxy interface
diff --git a/bindings/network-manager/nm_vpn_connection.mli b/bindings/network-manager/nm_vpn_connection.mli
new file mode 100644
index 0000000..0104606
--- /dev/null
+++ b/bindings/network-manager/nm_vpn_connection.mli
@@ -0,0 +1,20 @@
+(*
+ * nm_vpn_connection.mli
+ * ---------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** VPN connections *)
+
+include OBus_proxy.Private
+
+val vpn_state_changed : t -> (int * int) OBus_signal.t
+val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t
+
+val vpn_state : t -> int OBus_property.r
+val banner : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/network-manager/nm_vpn_plugin.ml b/bindings/network-manager/nm_vpn_plugin.ml
new file mode 100644
index 0000000..8738593
--- /dev/null
+++ b/bindings/network-manager/nm_vpn_plugin.ml
@@ -0,0 +1,50 @@
+(*
+ * nm_vpn_plugin.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *)
+
+include OBus_proxy.Private
+
+open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Plugin
+
+let connect proxy ~connection =
+  OBus_method.call m_Connect proxy connection
+
+let need_secrets proxy ~settings =
+  OBus_method.call m_NeedSecrets proxy settings
+
+let disconnect proxy =
+  OBus_method.call m_Disconnect proxy ()
+
+let set_ip4_config proxy ~config =
+  OBus_method.call m_SetIp4Config proxy config
+
+let set_failure proxy ~reason =
+  OBus_method.call m_SetFailure proxy reason
+
+let state proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy)
+
+let state_changed proxy =
+  OBus_signal.map
+    (fun state ->
+       let state = Int32.to_int state in
+       state)
+    (OBus_signal.make s_StateChanged proxy)
+
+let ip4_config proxy =
+  OBus_signal.make s_Ip4Config proxy
+
+let login_banner proxy =
+  OBus_signal.make s_LoginBanner proxy
+
+let failure proxy =
+  OBus_signal.map
+    (fun reason ->
+       let reason = Int32.to_int reason in
+       reason)
+    (OBus_signal.make s_Failure proxy)
diff --git a/bindings/network-manager/nm_vpn_plugin.mli b/bindings/network-manager/nm_vpn_plugin.mli
new file mode 100644
index 0000000..8dee401
--- /dev/null
+++ b/bindings/network-manager/nm_vpn_plugin.mli
@@ -0,0 +1,25 @@
+(*
+ * nm_vpn_plugin.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** VPN plugin interface *)
+
+include OBus_proxy.Private
+
+val connect : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t
+val need_secrets : t -> settings : (string * (string * OBus_value.V.single) list) list -> string Lwt.t
+val disconnect : t -> unit Lwt.t
+val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t
+val set_failure : t -> reason : string -> unit Lwt.t
+
+val state_changed : t -> int OBus_signal.t
+val ip4_config : t -> (string * OBus_value.V.single) list OBus_signal.t
+val login_banner : t -> string OBus_signal.t
+val failure : t -> int OBus_signal.t
+
+val state : t -> int OBus_property.r
diff --git a/bindings/notification/dune b/bindings/notification/dune
new file mode 100644
index 0000000..b6cf801
--- /dev/null
+++ b/bindings/notification/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_notification)
+ (public_name obus.notification)
+ (wrapped false)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets notification_interfaces.ml notification_interfaces.mli)
+ (deps    notification_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o notification_interfaces %{deps})))
diff --git a/bindings/notification/notification.ml b/bindings/notification/notification.ml
new file mode 100644
index 0000000..714cfa9
--- /dev/null
+++ b/bindings/notification/notification.ml
@@ -0,0 +1,345 @@
+(*
+ * notification.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
+open Lwt
+open OBus_value
+
+let app_name = ref (Filename.basename Sys.argv.(0))
+let desktop_entry = ref None
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+type server_info = {
+  server_name : string;
+  server_vendor : string;
+  server_version : string;
+  server_spec_version : string;
+}
+
+type image = {
+  img_width : int;
+  img_height : int;
+  img_rowstride : int;
+  img_has_alpha : bool;
+  img_bits_per_sample : int;
+  img_channels : int;
+  img_data : string;
+}
+
+type urgency = [ `Low | `Normal | `Critical ]
+
+type id = int32
+    (* An notification id *)
+
+(* All informations about an opened notification *)
+type notification = {
+  mutable notif_deleted : bool;
+  (* Wether the notification as already been closed *)
+
+  notif_action : string -> unit;
+  (* Wakeup the waiting thread when an action is received *)
+
+  notif_closed : unit -> unit;
+  (* Wakeup the waiting thread with [`Closed] when a notification is
+     closed *)
+}
+
+type 'a t = {
+  result : 'a Lwt.t;
+  notification : notification;
+  peer : OBus_peer.t;
+  id : id;
+}
+
+module Peer_map = Map.Make(OBus_peer)
+module Id_map = Map.Make(Int32)
+
+let notifications : notification Id_map.t ref Peer_map.t ref = ref Peer_map.empty
+  (* All opened notifications, by peer then id *)
+
+let default_action = "default"
+  (* Default action for notifications *)
+
+(* +-----------------------------------------------------------------+
+   | D-Bus methods and signals                                       |
+   +-----------------------------------------------------------------+ *)
+
+let server_name = "org.freedesktop.Notifications"
+let server_path = ["org"; "freedesktop"; "Notifications"]
+
+open Notification_interfaces.Org_freedesktop_Notifications
+
+let proxy = lazy(
+  let%lwt bus = OBus_bus.session () in
+  return (OBus_proxy.make (OBus_peer.make bus server_name) server_path)
+)
+
+let get_server_information () =
+  let%lwt proxy = Lazy.force proxy in
+  let%lwt name, vendor, version, spec_version = OBus_method.call m_GetServerInformation proxy () in
+  return {
+    server_name = name;
+    server_vendor = vendor;
+    server_version = version;
+    server_spec_version = spec_version;
+  }
+
+let get_capabilities () =
+  let%lwt proxy = Lazy.force proxy in
+  OBus_method.call m_GetCapabilities proxy ()
+
+let notify proxy ~app_name ~id ~icon ~summary ~body ~actions ~hints ~timeout =
+  let%lwt context, return_id = OBus_method.call_with_context m_Notify proxy (app_name, id, icon, summary, body, actions, hints, Int32.of_int timeout) in
+  return (OBus_context.sender context, return_id)
+
+let close_notification proxy id =
+  OBus_method.call m_CloseNotification proxy id
+
+let s_NotificationClosed =
+  OBus_member.Signal.make
+    ~interface:"org.freedesktop.Notifications"
+    ~member:"NotificationClosed"
+    ~args:(arg2
+             (None, C.basic_uint32)
+             (None, C.basic_uint32))
+    ~annotations:[]
+
+let notification_closed proxy =
+  OBus_signal.make s_NotificationClosed proxy
+
+let s_ActionInvoked =
+  OBus_member.Signal.make
+    ~interface:"org.freedesktop.Notifications"
+    ~member:"ActionInvoked"
+    ~args:(arg2
+             (None, C.basic_uint32)
+             (None, C.basic_string))
+    ~annotations:[]
+
+let action_invoked proxy =
+  OBus_signal.make s_ActionInvoked proxy
+
+(* +-----------------------------------------------------------------+
+   | Notifications monitoring                                        |
+   +-----------------------------------------------------------------+ *)
+
+let monitor_peer peer =
+  ignore begin
+    let%lwt () = OBus_peer.wait_for_exit peer in
+    let m = Peer_map.find peer !notifications in
+    notifications := Peer_map.remove peer !notifications;
+    (* Cancel all opened notification opened on this peer: *)
+    Id_map.iter (fun id notif -> notif.notif_closed ()) !m;
+    return ()
+  end
+
+let remove_notification peer id notif =
+  notif.notif_deleted <- true;
+  let r = Peer_map.find peer !notifications in
+  r :=  Id_map.remove id !r
+
+let init_callbacks = lazy(
+  let%lwt bus = OBus_bus.session () in
+
+  (* Create an anymous proxy for connecting signals, so we will
+     receive signals comming from any daemon *)
+  let anonymous_proxy = { OBus_proxy.peer = OBus_peer.anonymous bus;
+                          OBus_proxy.path = server_path } in
+
+  let%lwt event =
+    OBus_signal.connect
+      (OBus_signal.map_with_context
+         (fun context (id, reason) -> (OBus_context.sender context, id, reason))
+         (notification_closed anonymous_proxy))
+  in
+
+  (* Handle signals for closed notifications *)
+  E.keep
+    (E.map_p
+       (fun (peer, id, reason) ->
+          match try Some(Peer_map.find peer !notifications) with Not_found -> None with
+            | None ->
+                return ()
+            | Some m ->
+                match try Some(Id_map.find id !m) with Not_found -> None with
+                  | None ->
+                      return ()
+                  | Some notif ->
+                      remove_notification peer id notif;
+                      notif.notif_closed ();
+                      return ())
+       event);
+
+  let%lwt event =
+    OBus_signal.connect
+      (OBus_signal.map_with_context
+         (fun context (id, action) -> (OBus_context.sender context, id, action))
+         (action_invoked anonymous_proxy))
+  in
+
+  (* Handle signals for actions *)
+  E.keep
+    (E.map_p
+       (fun (peer, id, action) ->
+          match try Some(Peer_map.find peer !notifications) with Not_found -> None with
+            | None ->
+                return ()
+            | Some m ->
+                match try Some(Id_map.find id !m) with Not_found -> None with
+                  | None ->
+                      return ()
+                  | Some notif ->
+                      remove_notification peer id notif;
+                      notif.notif_action action;
+                      return ())
+       event);
+
+  return ()
+)
+
+(* +-----------------------------------------------------------------+
+   | Operations on notifications                                     |
+   +-----------------------------------------------------------------+ *)
+
+let result n = n.result
+
+let close n =
+  let notif = n.notification in
+  if not notif.notif_deleted then begin
+    remove_notification n.peer n.id notif;
+    notif.notif_closed ();
+    (* Call the method on the peer which have opened the
+       notification *)
+    close_notification (OBus_proxy.make n.peer server_path) n.id
+  end else
+    return ()
+
+(* +-----------------------------------------------------------------+
+   | Openning notifications                                          |
+   +-----------------------------------------------------------------+ *)
+
+let rec filter_opt = function
+  | [] -> []
+  | Some x :: l ->
+      x :: filter_opt l
+  | None :: l ->
+      filter_opt l
+
+let default_desktop_entry = desktop_entry
+
+let notify ?(app_name= !app_name) ?desktop_entry
+    ?replace ?(icon="") ?image ~summary ?(body="") ?(actions=[])
+    ?urgency ?category ?sound_file ?suppress_sound ?pos ?(hints=[]) ?(timeout= -1) () =
+
+  let desktop_entry =
+    match desktop_entry with
+      | None -> !default_desktop_entry
+      | x -> x
+  in
+
+  (*** Creation of hints ***)
+  let make_hint name x f =
+    match x with
+      | Some x -> Some(name, f x)
+      | None -> None
+  in
+  let hints =
+    filter_opt
+      [make_hint "desktop-entry" desktop_entry V.basic_string;
+       make_hint "image_data" image
+         (fun image ->
+            V.structure
+              [V.basic_int32 (Int32.of_int image.img_width);
+               V.basic_int32 (Int32.of_int image.img_height);
+               V.basic_int32 (Int32.of_int image.img_rowstride);
+               V.basic_boolean image.img_has_alpha;
+               V.basic_int32 (Int32.of_int image.img_bits_per_sample);
+               V.basic_int32 (Int32.of_int image.img_channels);
+               V.byte_array image.img_data]);
+       make_hint "urgency" urgency
+         (fun urgency ->
+            V.basic_int32 (match urgency with
+                             | `Low -> 0l
+                             | `Normal -> 1l
+                             | `Critical -> 2l));
+       make_hint "category" category V.basic_string;
+       make_hint "sound-file" sound_file V.basic_string;
+       make_hint "suppress-sound" suppress_sound V.basic_boolean;
+       make_hint "x" pos (fun (x, y) -> V.basic_int32(Int32.of_int x));
+       make_hint "y" pos (fun (x, y) -> V.basic_int32(Int32.of_int y))]
+    @ hints in
+
+  (*** Handling of actions ***)
+  let _, actions, actions_map =
+    List.fold_right
+      (fun (text, user_key) (acc, al, am) ->
+         (* For each action, generate a key and associate it to the
+            given function *)
+         let key = Printf.sprintf "key%d" acc in
+         (acc + 1, key :: text :: al, (key, user_key) :: am))
+      actions (0, [], []) in
+  let actions_map = (default_action, `Default) :: actions_map in
+
+  (* Setup callbacks *)
+  let%lwt () = Lazy.force init_callbacks in
+
+  (* Get the proxy *)
+  let%lwt daemon = Lazy.force proxy in
+
+  (* Create the notification *)
+  let%lwt peer, id =
+    notify
+      daemon
+      ~app_name
+      ~id:(match replace with
+             | Some n -> n.id
+             | None -> 0l)
+      ~icon
+      ~summary
+      ~body
+      ~actions
+      ~hints
+      ~timeout
+  in
+
+  let waiter, wakener = wait () in
+  let notif = {
+    notif_deleted = false;
+    notif_action = (fun action ->
+                      wakeup wakener (try
+                                        List.assoc action actions_map
+                                      with Not_found ->
+                                        `Default));
+    notif_closed = (fun () -> wakeup wakener `Closed);
+  } in
+
+  begin
+    try
+      let r = Peer_map.find peer !notifications in
+      r := Id_map.add id notif !r
+    with Not_found ->
+      notifications :=
+        Peer_map.add
+          peer
+          (ref (Id_map.add id notif Id_map.empty))
+          !notifications;
+      (* Monitor the peer to be sure the notification is closed when
+         the peer exits *)
+      monitor_peer peer
+  end;
+
+  return {
+    result = waiter;
+    notification = notif;
+    peer = peer;
+    id = id;
+  }
diff --git a/bindings/notification/notification.mli b/bindings/notification/notification.mli
new file mode 100644
index 0000000..0d59a35
--- /dev/null
+++ b/bindings/notification/notification.mli
@@ -0,0 +1,117 @@
+(*
+ * notification.mli
+ * ----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Popup notifications *)
+
+(** For complete details about notifications, look at the
+    {{:http://www.galago-project.org/specs/notification/} the official
+    specifications} *)
+
+val app_name : string ref
+  (** Application name used for notification. The default value is
+      taken from [Sys.argv.(0)] *)
+
+val desktop_entry : string option ref
+  (** If the application has a desktop entry, it can be specified
+      here *)
+
+(** {6 Operations on notifications} *)
+
+(** Type of an opened notifications *)
+type 'a t
+
+val result : 'a t -> 'a Lwt.t
+  (** Waits for a notification to be closed then returns:
+
+      - [`Closed] if the user clicked on the cross, timeout was
+      reached or the notification daemon exited
+
+      - [`Default] if the default action was invoked, i.e. the user
+      clicked on the notification, but not on a buttons
+
+      - the corresponding action if the user clicked on a button other
+      than the cross *)
+
+val close : 'a t -> unit Lwt.t
+  (** Close the notification now *)
+
+(** {6 Opening notifications} *)
+
+type urgency = [ `Low | `Normal | `Critical ]
+    (** Urgency level of popups *)
+
+(** An image description *)
+type image = {
+  img_width : int;
+  img_height : int;
+  img_rowstride : int;
+  img_has_alpha: bool;
+  img_bits_per_sample : int;
+  img_channels : int;
+  img_data : string;
+}
+
+val notify :
+  ?app_name : string ->
+  ?desktop_entry : string ->
+  ?replace : _ t ->
+  ?icon : string ->
+  ?image : image ->
+  summary : string ->
+  ?body : string ->
+  ?actions : (string * ([> `Default | `Closed ] as 'a)) list ->
+  ?urgency : urgency ->
+  ?category : string ->
+  ?sound_file : string ->
+  ?suppress_sound : bool ->
+  ?pos : int * int ->
+  ?hints : (string * OBus_value.V.single) list ->
+  ?timeout : int ->
+  unit -> 'a t Lwt.t
+  (** Open a notification.
+
+      - [app_name] and [desktop_entry] can override default values
+      taken from references
+      - [replace] is a popup id this notification replace
+      - [icon] is the notification icon. It is either as a URI (file://...) or a
+      name in a freedesktop.org-compliant icon theme (not a GTK+ stock ID)
+      - [image] is an image, it is used if [icon] is not present
+      - [summary] is a single line overview of the notification
+      - [body] is a multi-line body of text. Each line is a paragraph,
+      server implementations are free to word wrap them as they see fit.
+      The body may contain simple markup as specified in Markup. It must be
+      encoded using UTF-8.  If the body is omitted, just the summary is
+      displayed.
+      - [action] is a list of (text, key) pair, [text] is the text displayed to the user
+      and [key] is the value which will be returned when the action is invoked
+      - [category] is a string representing the category of the
+      notification, for example: "device.added", "email.arrived"
+      (more category can be found in the specifications)
+      - [sound_file] is a sound file to play while displaying the notification
+      - [suppress_sound] tell the daemon to suppress sounds
+      - [pos] is a screen position
+      - [hints] is a list of additionnal hints
+      - [timeout] is a timeout in millisecond
+  *)
+
+(** {6 Informations} *)
+
+(** Server informations *)
+type server_info = {
+  server_name : string;
+  server_vendor : string;
+  server_version : string;
+  server_spec_version : string;
+}
+
+val get_server_information : unit -> server_info Lwt.t
+  (** Retreive server informations *)
+
+val get_capabilities : unit -> string list Lwt.t
+  (** Retreive server capabilities, see specification for details *)
diff --git a/bindings/notification/notification_interfaces.obus b/bindings/notification/notification_interfaces.obus
new file mode 100644
index 0000000..523ac0c
--- /dev/null
+++ b/bindings/notification/notification_interfaces.obus
@@ -0,0 +1,15 @@
+(*
+ * notification_interfaces.obus
+ * ----------------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.Notifications {
+  method GetServerInformation : () -> (return_name : string, return_vendor : string, return_version : string, return_spec_version : string)
+  method GetCapabilities : () -> (return_caps : string array)
+  method CloseNotification : (id : uint32) -> ()
+  method Notify : (app_name : string, id : uint32, icon : string, summary : string, body : string, actions : string array, hints : (string, variant) dict, timeout : int32) -> (return_id : uint32)
+}
diff --git a/bindings/policykit/dune b/bindings/policykit/dune
new file mode 100644
index 0000000..81be6ca
--- /dev/null
+++ b/bindings/policykit/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_policy_kit)
+ (public_name obus.policykit)
+ (wrapped false)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets policy_kit_interfaces.ml policy_kit_interfaces.mli)
+ (deps    policy_kit_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o policy_kit_interfaces %{deps})))
diff --git a/bindings/policykit/policy_kit.ml b/bindings/policykit/policy_kit.ml
new file mode 100644
index 0000000..2e038c5
--- /dev/null
+++ b/bindings/policykit/policy_kit.ml
@@ -0,0 +1,21 @@
+(*
+ * policy_kit.ml
+ * -------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+let not_authorized = "org.freedesktop.PolicyKit.Error.NotAuthorized"
+
+open Policy_kit_interfaces.Org_freedesktop_PolicyKit_AuthenticationAgent
+
+let obtain_authorization ~action_id ?(xid=0) ~pid () =
+  let%lwt session_bus = OBus_bus.session () in
+  let proxy =
+    OBus_proxy.make
+      (OBus_peer.make session_bus "org.freedesktop.PolicyKit.AuthenticationAgent")
+      []
+  in
+  OBus_method.call m_ObtainAuthorization proxy (action_id, Int32.of_int xid, Int32.of_int pid)
diff --git a/bindings/policykit/policy_kit.mli b/bindings/policykit/policy_kit.mli
new file mode 100644
index 0000000..8317fb1
--- /dev/null
+++ b/bindings/policykit/policy_kit.mli
@@ -0,0 +1,24 @@
+(*
+ * policy_kit.mli
+ * --------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** PolicyKit interface *)
+
+val not_authorized : OBus_error.name
+  (** Exception raised by services when trying to perform an action
+      for which we do not have authorization from PolicyKit *)
+
+val obtain_authorization : action_id : string -> ?xid : int -> pid : int -> unit -> bool Lwt.t
+  (** [obtain_authorization ~action_id ~xid ~pid] tries to obtain
+      authorization for [action_id]. It returns whether it succeed or not.
+
+      @param action_id PolicyKit action identifier; see PolKitAction
+      @param xid X11 window ID for the top-level X11 window the dialog
+             will be transient for
+      @param pid Process ID to grant authorization to
+  *)
diff --git a/bindings/policykit/policy_kit_interfaces.obus b/bindings/policykit/policy_kit_interfaces.obus
new file mode 100644
index 0000000..ce3b12b
--- /dev/null
+++ b/bindings/policykit/policy_kit_interfaces.obus
@@ -0,0 +1,12 @@
+(*
+ * policy_kit_interfaces.obus
+ * --------------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.PolicyKit.AuthenticationAgent {
+  method ObtainAuthorization : (action_id : string, xid : uint32, pid : uint32) -> (gained_authorization : boolean)
+}
diff --git a/bindings/udisks/dune b/bindings/udisks/dune
new file mode 100644
index 0000000..4454725
--- /dev/null
+++ b/bindings/udisks/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_udisks)
+ (public_name obus.udisks)
+ (wrapped false)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets uDisks_interfaces.ml uDisks_interfaces.mli)
+ (deps    uDisks_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o uDisks_interfaces %{deps})))
diff --git a/bindings/udisks/uDisks.ml b/bindings/udisks/uDisks.ml
new file mode 100644
index 0000000..7a4f986
--- /dev/null
+++ b/bindings/udisks/uDisks.ml
@@ -0,0 +1,298 @@
+(*
+ * uDisks.ml
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+type inhibit_cookie = string
+type all_spindown_timeouts_cookie = string
+type inhibit_all_polling_cookie = string
+
+type fs = {
+  fs_id : string;
+  fs_name : string;
+  fs_supports_unix_owners : bool;
+  fs_can_mount : bool;
+  fs_can_create : bool;
+  fs_max_label_len : int;
+  fs_supports_label_rename : bool;
+  fs_supports_online_label_rename : bool;
+  fs_supports_fsck : bool;
+  fs_supports_online_fsck : bool;
+  fs_supports_resize_enlarge : bool;
+  fs_supports_online_resize_enlarge : bool;
+  fs_supports_resize_shrink : bool;
+  fs_supports_online_resize_shrink : bool;
+}
+
+type job = {
+  job_device : UDisks_device.t;
+  job_in_progress : bool;
+  job_is_cancellable : bool;
+  job_id : string;
+  job_num_tasks : int;
+  job_cur_task : int;
+  job_cur_task_id : string;
+  job_cur_task_percentage : float;
+}
+
+(* +-----------------------------------------------------------------+
+   | Exceptions                                                      |
+   +-----------------------------------------------------------------+ *)
+
+exception Busy
+exception Cancelled
+exception Failed
+exception Filesystem_driver_missing
+exception Filesystem_tools_missing
+exception Inhibited
+exception Invalid_option
+exception Not_found
+exception Not_supported
+exception Permission_denied
+
+let busy = "org.freedesktop.UDisks.Error.Busy"
+let cancelled = "org.freedesktop.UDisks.Error.Cancelled"
+let failed = "org.freedesktop.UDisks.Error.Failed"
+let filesystem_driver_missing = "org.freedesktop.UDisks.Error.FilesystemDriverMissing"
+let filesystem_tools_missing = "org.freedesktop.UDisks.Error.FilesystemToolsMissing"
+let inhibited = "org.freedesktop.UDisks.Error.Inhibited"
+let invalid_option = "org.freedesktop.UDisks.Error.InvalidOption"
+let not_found = "org.freedesktop.UDisks.Error.NotFound"
+let not_supported = "org.freedesktop.UDisks.Error.NotSupported"
+let permission_denied = "org.freedesktop.UDisks.Error.PermissionDenied"
+
+(* +-----------------------------------------------------------------+
+   | D-Bus definitions                                               |
+   +-----------------------------------------------------------------+ *)
+
+include OBus_peer.Private
+
+let daemon () =
+  let%lwt bus = OBus_bus.system () in
+  return (OBus_peer.make bus "org.freedesktop.UDisks")
+
+open UDisks_interfaces.Org_freedesktop_UDisks
+
+let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "UDisks"]
+
+let make_device context path =
+  UDisks_device.of_proxy (OBus_proxy.make (OBus_context.sender context) path)
+let make_adapter context path =
+  UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) path)
+let make_expander context path =
+  UDisks_expander.of_proxy (OBus_proxy.make (OBus_context.sender context) path)
+let make_port context path =
+  UDisks_port.of_proxy (OBus_proxy.make (OBus_context.sender context) path)
+
+let enumerate_adapters daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateAdapters (proxy daemon) () in
+  return (List.map (make_adapter context) devices)
+
+let enumerate_expanders daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateExpanders (proxy daemon) () in
+  return (List.map (make_expander context) devices)
+
+let enumerate_ports daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_EnumeratePorts (proxy daemon) () in
+  return (List.map (make_port context) devices)
+
+let enumerate_devices daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateDevices (proxy daemon) () in
+  return (List.map (make_device context) devices)
+
+let enumerate_device_files daemon =
+  OBus_method.call m_EnumerateDeviceFiles (proxy daemon) ()
+
+let find_device_by_device_file daemon ~device_file =
+  let%lwt (context, device) = OBus_method.call_with_context m_FindDeviceByDeviceFile (proxy daemon) device_file in
+  return (make_device context device)
+
+let find_device_by_major_minor daemon ~device_major ~device_minor =
+  let%lwt (context, device) = OBus_method.call_with_context m_FindDeviceByMajorMinor (proxy daemon) (device_major, device_minor) in
+  return (make_device context device)
+
+let drive_inhibit_all_polling daemon ~options =
+  OBus_method.call m_DriveInhibitAllPolling (proxy daemon) options
+
+let drive_uninhibit_all_polling daemon ~cookie =
+  OBus_method.call m_DriveUninhibitAllPolling (proxy daemon) cookie
+
+let drive_set_all_spindown_timeouts daemon ~timeout_seconds ~options =
+  let timeout_seconds = Int32.of_int timeout_seconds in
+  OBus_method.call m_DriveSetAllSpindownTimeouts (proxy daemon) (timeout_seconds, options)
+
+let drive_unset_all_spindown_timeouts daemon ~cookie =
+  OBus_method.call m_DriveUnsetAllSpindownTimeouts (proxy daemon) cookie
+
+let linux_lvm2_vgstart daemon ~uuid ~options =
+  OBus_method.call m_LinuxLvm2VGStart (proxy daemon) (uuid, options)
+
+let linux_lvm2_vgstop daemon ~uuid ~options =
+  OBus_method.call m_LinuxLvm2VGStop (proxy daemon) (uuid, options)
+
+let linux_lvm2_vgset_name daemon ~uuid ~name =
+  OBus_method.call m_LinuxLvm2VGSetName (proxy daemon) (uuid, name)
+
+let linux_lvm2_vgadd_pv daemon ~uuid ~physical_volume ~options =
+  let physical_volume = OBus_proxy.path (UDisks_device.to_proxy physical_volume) in
+  OBus_method.call m_LinuxLvm2VGAddPV (proxy daemon) (uuid, physical_volume, options)
+
+let linux_lvm2_vgremove_pv daemon ~vg_uuid ~pv_uuid ~options =
+  OBus_method.call m_LinuxLvm2VGRemovePV (proxy daemon) (vg_uuid, pv_uuid, options)
+
+let linux_lvm2_lvset_name daemon ~group_uuid ~uuid ~name =
+  OBus_method.call m_LinuxLvm2LVSetName (proxy daemon) (group_uuid, uuid, name)
+
+let linux_lvm2_lvstart daemon ~group_uuid ~uuid ~options =
+  OBus_method.call m_LinuxLvm2LVStart (proxy daemon) (group_uuid, uuid, options)
+
+let linux_lvm2_lvremove daemon ~group_uuid ~uuid ~options =
+  OBus_method.call m_LinuxLvm2LVRemove (proxy daemon) (group_uuid, uuid, options)
+
+let linux_lvm2_lvcreate daemon ~group_uuid ~name ~size ~num_stripes ~stripe_size ~num_mirrors ~options ~fstype ~fsoptions =
+  let num_stripes = Int32.of_int num_stripes in
+  let num_mirrors = Int32.of_int num_mirrors in
+  let%lwt (context, created_device) = OBus_method.call_with_context m_LinuxLvm2LVCreate (proxy daemon) (group_uuid, name, size, num_stripes, stripe_size, num_mirrors, options, fstype, fsoptions) in
+  return (make_device context created_device)
+
+let linux_md_start daemon ~components ~options =
+  let components = List.map (fun c -> OBus_proxy.path (UDisks_device.to_proxy c)) components in
+  let%lwt (context, device) = OBus_method.call_with_context m_LinuxMdStart (proxy daemon) (components, options) in
+  return (make_device context device)
+
+let linux_md_create daemon ~components ~level ~stripe_size ~name ~options =
+  let components = List.map (fun c -> OBus_proxy.path (UDisks_device.to_proxy c)) components in
+  let%lwt (context, device) = OBus_method.call_with_context m_LinuxMdCreate (proxy daemon) (components, level, stripe_size, name, options) in
+  return (make_device context device)
+
+let inhibit daemon =
+  OBus_method.call m_Inhibit (proxy daemon) ()
+
+let uninhibit daemon ~cookie =
+  OBus_method.call m_Uninhibit (proxy daemon) cookie
+
+let device_added daemon =
+  OBus_signal.map_with_context
+    make_device
+    (OBus_signal.make s_DeviceAdded (proxy daemon))
+
+let device_removed daemon =
+  OBus_signal.map_with_context
+    make_device
+    (OBus_signal.make s_DeviceRemoved (proxy daemon))
+
+let device_changed daemon =
+  OBus_signal.map_with_context
+    make_device
+    (OBus_signal.make s_DeviceChanged (proxy daemon))
+
+let device_job_changed daemon =
+  OBus_signal.map_with_context
+    (fun context (device, job_in_progress, job_is_cancellable, job_id, job_num_tasks, job_cur_task, job_cur_task_id, job_cur_task_percentage) -> {
+       job_device = make_device context device;
+       job_in_progress = job_in_progress;
+       job_is_cancellable = job_is_cancellable;
+       job_id = job_id;
+       job_num_tasks = Int32.to_int job_num_tasks;
+       job_cur_task = Int32.to_int job_cur_task;
+       job_cur_task_id = job_cur_task_id;
+       job_cur_task_percentage = job_cur_task_percentage;
+     })
+    (OBus_signal.make s_DeviceJobChanged (proxy daemon))
+
+let adapter_added daemon =
+  OBus_signal.map_with_context
+    make_adapter
+    (OBus_signal.make s_AdapterAdded (proxy daemon))
+
+let adapter_removed daemon =
+  OBus_signal.map_with_context
+    make_adapter
+    (OBus_signal.make s_AdapterRemoved (proxy daemon))
+
+let adapter_changed daemon =
+  OBus_signal.map_with_context
+    make_adapter
+    (OBus_signal.make s_AdapterChanged (proxy daemon))
+
+let expander_added daemon =
+  OBus_signal.map_with_context
+    make_expander
+    (OBus_signal.make s_ExpanderAdded (proxy daemon))
+
+let expander_removed daemon =
+  OBus_signal.map_with_context
+    make_expander
+    (OBus_signal.make s_ExpanderRemoved (proxy daemon))
+
+let expander_changed daemon =
+  OBus_signal.map_with_context
+    make_expander
+    (OBus_signal.make s_ExpanderChanged (proxy daemon))
+
+let port_added daemon =
+  OBus_signal.map_with_context
+    make_port
+    (OBus_signal.make s_PortAdded (proxy daemon))
+
+let port_removed daemon =
+  OBus_signal.map_with_context
+    make_port
+    (OBus_signal.make s_PortRemoved (proxy daemon))
+
+let port_changed daemon =
+  OBus_signal.map_with_context
+    make_port
+    (OBus_signal.make s_PortChanged (proxy daemon))
+
+let daemon_version daemon =
+  OBus_property.make p_DaemonVersion (proxy daemon)
+
+let daemon_is_inhibited daemon =
+  OBus_property.make p_DaemonIsInhibited (proxy daemon)
+
+let supports_luks_devices daemon =
+  OBus_property.make p_SupportsLuksDevices (proxy daemon)
+
+let known_filesystems daemon =
+  OBus_property.map_r
+    (fun l ->
+       List.map
+         (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) -> {
+            fs_id = x1;
+            fs_name = x2;
+            fs_supports_unix_owners = x3;
+            fs_can_mount = x4;
+            fs_can_create = x5;
+            fs_max_label_len = Int32.to_int x6;
+            fs_supports_label_rename = x7;
+            fs_supports_online_label_rename = x8;
+            fs_supports_fsck = x9;
+            fs_supports_online_fsck = x10;
+            fs_supports_resize_enlarge = x11;
+            fs_supports_online_resize_enlarge = x12;
+            fs_supports_resize_shrink = x13;
+            fs_supports_online_resize_shrink = x14;
+          })
+         l)
+    (OBus_property.make p_KnownFilesystems (proxy daemon))
+
+type properties = {
+  known_filesystems : fs list;
+  supports_luks_devices : bool;
+  daemon_is_inhibited : bool;
+  daemon_version : string;
+}
+
+let properties daemon =
+  OBus_property.group (proxy daemon) interface
diff --git a/bindings/udisks/uDisks.mli b/bindings/udisks/uDisks.mli
new file mode 100644
index 0000000..a08b1fd
--- /dev/null
+++ b/bindings/udisks/uDisks.mli
@@ -0,0 +1,170 @@
+(*
+ * uDisks.mli
+ * ----------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UDisks main interface *)
+
+include OBus_peer.Private
+
+val daemon : unit -> t Lwt.t
+  (** [daemon ()] returns the peer object for the udisks daemon *)
+
+(** {6 Exceptions} *)
+
+val busy : OBus_error.name
+val cancelled : OBus_error.name
+val failed : OBus_error.name
+val filesystem_driver_missing : OBus_error.name
+val filesystem_tools_missing : OBus_error.name
+val inhibited : OBus_error.name
+val invalid_option : OBus_error.name
+val not_found : OBus_error.name
+val not_supported : OBus_error.name
+val permission_denied : OBus_error.name
+
+(** {6 Methods} *)
+
+type inhibit_cookie
+
+val inhibit : t -> inhibit_cookie Lwt.t
+val uninhibit : t -> cookie : inhibit_cookie -> unit Lwt.t
+
+val linux_md_create : t ->
+  components : UDisks_device.t list ->
+  level : string ->
+  stripe_size : int64 ->
+  name : string ->
+  options : string list ->
+  UDisks_device.t Lwt.t
+val linux_md_start : t ->
+  components : UDisks_device.t list ->
+  options : string list ->
+  UDisks_device.t Lwt.t
+
+val linux_lvm2_lvcreate : t ->
+  group_uuid : string ->
+  name : string ->
+  size : int64 ->
+  num_stripes : int ->
+  stripe_size : int64 ->
+  num_mirrors : int ->
+  options : string list ->
+  fstype : string ->
+  fsoptions : string list ->
+  UDisks_device.t Lwt.t
+val linux_lvm2_lvremove : t -> group_uuid : string -> uuid : string -> options : string list -> unit Lwt.t
+val linux_lvm2_lvstart : t -> group_uuid : string -> uuid : string -> options : string list -> unit Lwt.t
+val linux_lvm2_lvset_name : t -> group_uuid : string -> uuid : string -> name : string -> unit Lwt.t
+val linux_lvm2_vgremove_pv : t -> vg_uuid : string -> pv_uuid : string -> options : string list -> unit Lwt.t
+val linux_lvm2_vgadd_pv : t -> uuid : string -> physical_volume : UDisks_device.t -> options : string list -> unit Lwt.t
+val linux_lvm2_vgset_name : t -> uuid : string -> name : string -> unit Lwt.t
+val linux_lvm2_vgstop : t -> uuid : string -> options : string list -> unit Lwt.t
+val linux_lvm2_vgstart : t -> uuid : string -> options : string list -> unit Lwt.t
+
+type all_spindown_timeouts_cookie
+
+val drive_set_all_spindown_timeouts : t -> timeout_seconds : int -> options : string list -> all_spindown_timeouts_cookie Lwt.t
+val drive_unset_all_spindown_timeouts : t -> cookie : all_spindown_timeouts_cookie -> unit Lwt.t
+
+type inhibit_all_polling_cookie
+
+val drive_inhibit_all_polling : t -> options : string list -> inhibit_all_polling_cookie Lwt.t
+val drive_uninhibit_all_polling : t -> cookie : inhibit_all_polling_cookie -> unit Lwt.t
+
+val find_device_by_major_minor : t -> device_major : int64 -> device_minor : int64 -> UDisks_device.t Lwt.t
+val find_device_by_device_file : t -> device_file : string -> UDisks_device.t Lwt.t
+
+val enumerate_device_files : t -> string list Lwt.t
+val enumerate_devices : t -> UDisks_device.t list Lwt.t
+val enumerate_ports : t -> UDisks_port.t list Lwt.t
+val enumerate_expanders : t -> UDisks_expander.t list Lwt.t
+val enumerate_adapters : t -> UDisks_adapter.t list Lwt.t
+
+(** {6 Signals} *)
+
+val port_changed : t -> UDisks_port.t OBus_signal.t
+val port_removed : t -> UDisks_port.t OBus_signal.t
+val port_added : t -> UDisks_port.t OBus_signal.t
+
+val expander_changed : t -> UDisks_expander.t OBus_signal.t
+val expander_removed : t -> UDisks_expander.t OBus_signal.t
+val expander_added : t -> UDisks_expander.t OBus_signal.t
+
+val adapter_changed : t -> UDisks_adapter.t OBus_signal.t
+val adapter_removed : t -> UDisks_adapter.t OBus_signal.t
+val adapter_added : t -> UDisks_adapter.t OBus_signal.t
+
+val device_changed : t -> UDisks_device.t OBus_signal.t
+val device_removed : t -> UDisks_device.t OBus_signal.t
+val device_added : t -> UDisks_device.t OBus_signal.t
+
+type job = {
+  job_device : UDisks_device.t;
+  job_in_progress : bool;
+  (** Whether a job is currently in progress.</doc:summary *)
+  job_is_cancellable : bool;
+  (** Whether the job is cancellable *)
+  job_id : string;
+  (** The identifier of the job *)
+  job_num_tasks : int;
+  (** Number of tasks in the job *)
+  job_cur_task : int;
+  (** Current task number (zero-based offset) *)
+  job_cur_task_id : string;
+  (** Task identifier for current task *)
+  job_cur_task_percentage : float;
+  (** Percentage completed of current task (between 0 and 100, negative if unknown) *)
+}
+
+val device_job_changed : t -> job OBus_signal.t
+
+(** {6 Properties} *)
+
+(** File-system informations *)
+type fs = {
+  fs_id : string;
+  (** The name / identifier of the file system (such as ext3 or vfat),
+      similar to the contents of the Device:IdType property. *)
+  fs_name : string;
+  (** A human readable name for the file system such as "Linux
+      Ext3". *)
+  fs_supports_unix_owners : bool;
+  (** Whether the file system supports the UNIX owners model
+      (e.g. ext3 does, but vfat doesn't). *)
+  fs_can_mount : bool;
+  (** Whether the file system can be mounted. *)
+  fs_can_create : bool;
+  (** Whether the file system can be created on a device. *)
+  fs_max_label_len : int;
+  (** The maximum amount of bytes that the file system label can
+      hold. Set to zero if the file system doesn't support labels. *)
+  fs_supports_label_rename : bool;
+  (** Whether the label of the file system can be changed. *)
+  fs_supports_online_label_rename : bool;
+  (** Whether the label can be changed while the file system is
+      mounted. *)
+  fs_supports_fsck : bool;
+  (** Whether the file system can be checked. *)
+  fs_supports_online_fsck : bool;
+  (** Whether the file system can be checked while mounted. *)
+  fs_supports_resize_enlarge : bool;
+  (** Whether the file system can be enlarged. *)
+  fs_supports_online_resize_enlarge : bool;
+  (** Whether the file system can be enlarged while mounted. *)
+  fs_supports_resize_shrink : bool;
+  (** Whether the file system can be shrunk. *)
+  fs_supports_online_resize_shrink : bool;
+  (** Whether the file system can be shrunk while mounted. *)
+}
+
+val known_filesystems : t -> fs list OBus_property.r
+val supports_luks_devices : t -> bool OBus_property.r
+val daemon_is_inhibited : t -> bool OBus_property.r
+val daemon_version : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/udisks/uDisks_adapter.ml b/bindings/udisks/uDisks_adapter.ml
new file mode 100644
index 0000000..9edfe00
--- /dev/null
+++ b/bindings/udisks/uDisks_adapter.ml
@@ -0,0 +1,38 @@
+(*
+ * uDisks_adapter.ml
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+include OBus_proxy.Private
+
+open UDisks_interfaces.Org_freedesktop_UDisks_Adapter
+
+let changed proxy =
+  OBus_signal.make s_Changed proxy
+
+let native_path proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy
+
+let vendor proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy
+
+let model proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy
+
+let driver proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Driver proxy
+
+let num_ports proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy)
+
+let fabric proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Fabric proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface
diff --git a/bindings/udisks/uDisks_adapter.mli b/bindings/udisks/uDisks_adapter.mli
new file mode 100644
index 0000000..9c24d82
--- /dev/null
+++ b/bindings/udisks/uDisks_adapter.mli
@@ -0,0 +1,27 @@
+(*
+ * uDisks_adapter.mli
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UDisks adapter interface *)
+
+include OBus_proxy.Private
+
+(** {6 Signals} *)
+
+val changed : t -> unit OBus_signal.t
+
+(** {6 Properties} *)
+
+val fabric : t -> string OBus_property.r
+val num_ports : t -> int OBus_property.r
+val driver : t -> string OBus_property.r
+val model : t -> string OBus_property.r
+val vendor : t -> string OBus_property.r
+val native_path : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/udisks/uDisks_device.ml b/bindings/udisks/uDisks_device.ml
new file mode 100644
index 0000000..76a4544
--- /dev/null
+++ b/bindings/udisks/uDisks_device.ml
@@ -0,0 +1,620 @@
+(*
+ * uDisks_device.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+include OBus_proxy.Private
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+type benchmark_result = {
+  bench_read_transfer_rate_results : (int64 * float) list;
+  bench_write_transfer_rate_results : (int64 * float) list;
+  bench_access_time_results : (int64 * float) list;
+}
+
+type spindown_timeout_cookie = string
+type inhibit_polling_cookie = string
+
+type process = {
+  pr_pid : int;
+  pr_uid : int;
+  pr_comamnd_line : string;
+}
+
+type job = {
+  job_in_progress : bool;
+  job_id : string;
+  job_initiated_by_uid : int;
+  job_is_cancellable : bool;
+  job_cur_task_percentage : float;
+}
+
+(* +-----------------------------------------------------------------+
+   | D-Bus members                                                   |
+   +-----------------------------------------------------------------+ *)
+
+open UDisks_interfaces.Org_freedesktop_UDisks_Device
+
+let job_cancel proxy =
+  OBus_method.call m_JobCancel proxy ()
+
+let partition_table_create proxy ~scheme ~options =
+  OBus_method.call m_PartitionTableCreate proxy (scheme, options)
+
+let partition_delete proxy ~options =
+  OBus_method.call m_PartitionDelete proxy options
+
+let partition_create proxy ~offset ~size ~typ ~label ~flags ~options ~fstype ~fsoptions =
+  let%lwt (context, created_device) = OBus_method.call_with_context m_PartitionCreate proxy (offset, size, typ, label, flags, options, fstype, fsoptions) in
+  let created_device = OBus_proxy.make (OBus_context.sender context) created_device in
+  return created_device
+
+let partition_modify proxy ~typ ~label ~flags =
+  OBus_method.call m_PartitionModify proxy (typ, label, flags)
+
+let filesystem_create proxy ~fstype ~options =
+  OBus_method.call m_FilesystemCreate proxy (fstype, options)
+
+let filesystem_set_label proxy ~new_label =
+  OBus_method.call m_FilesystemSetLabel proxy new_label
+
+let filesystem_mount proxy ~filesystem_type ~options =
+  OBus_method.call m_FilesystemMount proxy (filesystem_type, options)
+
+let filesystem_unmount proxy ~options =
+  OBus_method.call m_FilesystemUnmount proxy options
+
+let filesystem_check proxy ~options =
+  OBus_method.call m_FilesystemCheck proxy options
+
+let filesystem_list_open_files proxy =
+  let%lwt processes = OBus_method.call m_FilesystemListOpenFiles proxy () in
+  return
+    (List.map
+       (fun (x1, x2, x3) -> {
+          pr_pid = Int32.to_int x1;
+          pr_uid = Int32.to_int x2;
+          pr_comamnd_line = x3;
+        })
+       processes)
+
+let luks_unlock proxy ~passphrase ~options =
+  let%lwt (context, cleartext_device) = OBus_method.call_with_context m_LuksUnlock proxy (passphrase, options) in
+  let cleartext_device = OBus_proxy.make (OBus_context.sender context) cleartext_device in
+  return cleartext_device
+
+let luks_lock proxy ~options =
+  OBus_method.call m_LuksLock proxy options
+
+let luks_change_passphrase proxy ~current_passphrase ~new_passphrase =
+  OBus_method.call m_LuksChangePassphrase proxy (current_passphrase, new_passphrase)
+
+let linux_md_add_spare proxy ~component ~options =
+  let component = OBus_proxy.path component in
+  OBus_method.call m_LinuxMdAddSpare proxy (component, options)
+
+let linux_md_expand proxy ~components ~options =
+  let components = List.map OBus_proxy.path components in
+  OBus_method.call m_LinuxMdExpand proxy (components, options)
+
+let linux_md_remove_component proxy ~component ~options =
+  let component = OBus_proxy.path component in
+  OBus_method.call m_LinuxMdRemoveComponent proxy (component, options)
+
+let linux_md_stop proxy ~options =
+  OBus_method.call m_LinuxMdStop proxy options
+
+let linux_lvm2_lvstop proxy ~options =
+  OBus_method.call m_LinuxLvm2LVStop proxy options
+
+let linux_md_check proxy ~options =
+  OBus_method.call m_LinuxMdCheck proxy options
+
+let drive_inhibit_polling proxy ~options =
+  OBus_method.call m_DriveInhibitPolling proxy options
+
+let drive_uninhibit_polling proxy ~cookie =
+  OBus_method.call m_DriveUninhibitPolling proxy cookie
+
+let drive_poll_media proxy =
+  OBus_method.call m_DrivePollMedia proxy ()
+
+let drive_eject proxy ~options =
+  OBus_method.call m_DriveEject proxy options
+
+let drive_detach proxy ~options =
+  OBus_method.call m_DriveDetach proxy options
+
+let drive_set_spindown_timeout proxy ~timeout_seconds ~options =
+  let timeout_seconds = Int32.of_int timeout_seconds in
+  OBus_method.call m_DriveSetSpindownTimeout proxy (timeout_seconds, options)
+
+let drive_unset_spindown_timeout proxy ~cookie =
+  OBus_method.call m_DriveUnsetSpindownTimeout proxy cookie
+
+let drive_ata_smart_refresh_data proxy ~options =
+  OBus_method.call m_DriveAtaSmartRefreshData proxy options
+
+let drive_ata_smart_initiate_selftest proxy ~test ~options =
+  OBus_method.call m_DriveAtaSmartInitiateSelftest proxy (test, options)
+
+let drive_benchmark proxy ~do_write_benchmark ~options =
+  let%lwt (x1, x2, x3) = OBus_method.call m_DriveBenchmark proxy (do_write_benchmark, options) in
+  return {
+    bench_read_transfer_rate_results = x1;
+    bench_write_transfer_rate_results = x2;
+    bench_access_time_results = x3;
+  }
+
+let changed proxy =
+  OBus_signal.make s_Changed proxy
+
+let job_changed proxy =
+  OBus_signal.map
+    (fun (job_in_progress, job_is_cancellable, job_id, job_initiated_by_uid, job_percentage) -> {
+       job_in_progress = job_in_progress;
+       job_id = job_id;
+       job_initiated_by_uid = Int32.to_int job_initiated_by_uid;
+       job_is_cancellable = job_is_cancellable;
+       job_cur_task_percentage = job_percentage;
+     })
+    (OBus_signal.make s_JobChanged proxy)
+
+let native_path proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy
+
+let device_detection_time proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceDetectionTime proxy
+
+let device_media_detection_time proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMediaDetectionTime proxy
+
+let device_major proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMajor proxy
+
+let device_minor proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMinor proxy
+
+let device_file proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFile proxy
+
+let device_file_presentation proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFilePresentation proxy
+
+let device_file_by_id proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFileById proxy
+
+let device_file_by_path proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFileByPath proxy
+
+let device_is_system_internal proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsSystemInternal proxy
+
+let device_is_partition proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsPartition proxy
+
+let device_is_partition_table proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsPartitionTable proxy
+
+let device_is_removable proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsRemovable proxy
+
+let device_is_media_available proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaAvailable proxy
+
+let device_is_media_change_detected proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetected proxy
+
+let device_is_media_change_detection_polling proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionPolling proxy
+
+let device_is_media_change_detection_inhibitable proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionInhibitable proxy
+
+let device_is_media_change_detection_inhibited proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionInhibited proxy
+
+let device_is_read_only proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsReadOnly proxy
+
+let device_is_drive proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsDrive proxy
+
+let device_is_optical_disc proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsOpticalDisc proxy
+
+let device_is_mounted proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMounted proxy
+
+let device_mount_paths proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMountPaths proxy
+
+let device_mounted_by_uid proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMountedByUid proxy)
+
+let device_is_luks proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLuks proxy
+
+let device_is_luks_cleartext proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLuksCleartext proxy
+
+let device_is_linux_md_component proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxMdComponent proxy
+
+let device_is_linux_md proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxMd proxy
+
+let device_is_linux_lvm2_lv proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLvm2LV proxy
+
+let device_is_linux_lvm2_pv proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLvm2PV proxy
+
+let device_is_linux_dmmp_component proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxDmmpComponent proxy
+
+let device_is_linux_dmmp proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxDmmp proxy
+
+let device_is_linux_loop proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLoop proxy
+
+let device_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceSize proxy
+
+let device_block_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceBlockSize proxy
+
+let device_presentation_hide proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationHide proxy
+
+let device_presentation_nopolicy proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationNopolicy proxy
+
+let device_presentation_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationName proxy
+
+let device_presentation_icon_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationIconName proxy
+
+let job_in_progress proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_JobInProgress proxy
+
+let job_id proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_JobId proxy
+
+let job_initiated_by_uid proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_JobInitiatedByUid proxy)
+
+let job_is_cancellable proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_JobIsCancellable proxy
+
+let job_percentage proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_JobPercentage proxy
+
+let id_usage proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_IdUsage proxy
+
+let id_type proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_IdType proxy
+
+let id_version proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_IdVersion proxy
+
+let id_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_IdUuid proxy
+
+let id_label proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_IdLabel proxy
+
+let luks_holder proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksHolder proxy)
+
+let luks_cleartext_slave proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksCleartextSlave proxy)
+
+let luks_cleartext_unlocked_by_uid proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksCleartextUnlockedByUid proxy)
+
+let partition_slave proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionSlave proxy)
+
+let partition_scheme proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionScheme proxy
+
+let partition_type proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionType proxy
+
+let partition_label proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionLabel proxy
+
+let partition_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionUuid proxy
+
+let partition_flags proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionFlags proxy
+
+let partition_number proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionNumber proxy)
+
+let partition_offset proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionOffset proxy
+
+let partition_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionSize proxy
+
+let partition_alignment_offset proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionAlignmentOffset proxy
+
+let partition_table_scheme proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionTableScheme proxy
+
+let partition_table_count proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionTableCount proxy)
+
+let drive_vendor proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveVendor proxy
+
+let drive_model proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveModel proxy
+
+let drive_revision proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveRevision proxy
+
+let drive_serial proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveSerial proxy
+
+let drive_wwn proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveWwn proxy
+
+let drive_rotation_rate proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveRotationRate proxy)
+
+let drive_write_cache proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveWriteCache proxy
+
+let drive_connection_interface proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveConnectionInterface proxy
+
+let drive_connection_speed proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveConnectionSpeed proxy
+
+let drive_media_compatibility proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveMediaCompatibility proxy
+
+let drive_media proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveMedia proxy
+
+let drive_is_media_ejectable proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveIsMediaEjectable proxy
+
+let drive_can_detach proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveCanDetach proxy
+
+let drive_can_spindown proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveCanSpindown proxy
+
+let drive_is_rotational proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveIsRotational proxy
+
+let drive_adapter proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x))
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAdapter proxy)
+
+let drive_ports proxy =
+  OBus_property.map_r_with_context
+    (fun context x ->
+       List.map
+         (fun path ->
+            UDisks_port.of_proxy (OBus_proxy.make (OBus_context.sender context) path))
+         x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_DrivePorts proxy)
+
+let drive_similar_devices proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveSimilarDevices proxy)
+
+let optical_disc_is_blank proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsBlank proxy
+
+let optical_disc_is_appendable proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsAppendable proxy
+
+let optical_disc_is_closed proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsClosed proxy
+
+let optical_disc_num_tracks proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumTracks proxy)
+
+let optical_disc_num_audio_tracks proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumAudioTracks proxy)
+
+let optical_disc_num_sessions proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumSessions proxy)
+
+let drive_ata_smart_is_available proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartIsAvailable proxy
+
+let drive_ata_smart_time_collected proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartTimeCollected proxy
+
+let drive_ata_smart_status proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartStatus proxy
+
+let drive_ata_smart_blob proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartBlob proxy
+
+let linux_md_component_level proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentLevel proxy
+
+let linux_md_component_position proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentPosition proxy)
+
+let linux_md_component_num_raid_devices proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentNumRaidDevices proxy)
+
+let linux_md_component_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentUuid proxy
+
+let linux_md_component_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentName proxy
+
+let linux_md_component_home_host proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentHomeHost proxy
+
+let linux_md_component_version proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentVersion proxy
+
+let linux_md_component_holder proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentHolder proxy)
+
+let linux_md_component_state proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentState proxy
+
+let linux_md_state proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdState proxy
+
+let linux_md_level proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdLevel proxy
+
+let linux_md_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdUuid proxy
+
+let linux_md_home_host proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdHomeHost proxy
+
+let linux_md_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdName proxy
+
+let linux_md_num_raid_devices proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdNumRaidDevices proxy)
+
+let linux_md_version proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdVersion proxy
+
+let linux_md_slaves proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSlaves proxy)
+
+let linux_md_is_degraded proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdIsDegraded proxy
+
+let linux_md_sync_action proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncAction proxy
+
+let linux_md_sync_percentage proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncPercentage proxy
+
+let linux_md_sync_speed proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncSpeed proxy
+
+let linux_lvm2_pvuuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVUuid proxy
+
+let linux_lvm2_pvnum_metadata_areas proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVNumMetadataAreas proxy)
+
+let linux_lvm2_pvgroup_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupName proxy
+
+let linux_lvm2_pvgroup_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupUuid proxy
+
+let linux_lvm2_pvgroup_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupSize proxy
+
+let linux_lvm2_pvgroup_unallocated_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupUnallocatedSize proxy
+
+let linux_lvm2_pvgroup_sequence_number proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupSequenceNumber proxy
+
+let linux_lvm2_pvgroup_extent_size proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupExtentSize proxy
+
+let linux_lvm2_pvgroup_physical_volumes proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupPhysicalVolumes proxy
+
+let linux_lvm2_pvgroup_logical_volumes proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupLogicalVolumes proxy
+
+let linux_lvm2_lvname proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVName proxy
+
+let linux_lvm2_lvuuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVUuid proxy
+
+let linux_lvm2_lvgroup_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVGroupName proxy
+
+let linux_lvm2_lvgroup_uuid proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVGroupUuid proxy
+
+let linux_dmmp_component_holder proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> OBus_proxy.make (OBus_context.sender context) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpComponentHolder proxy)
+
+let linux_dmmp_name proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpName proxy
+
+let linux_dmmp_slaves proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpSlaves proxy)
+
+let linux_dmmp_parameters proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpParameters proxy
+
+let linux_loop_filename proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLoopFilename proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface
+
diff --git a/bindings/udisks/uDisks_device.mli b/bindings/udisks/uDisks_device.mli
new file mode 100644
index 0000000..3516475
--- /dev/null
+++ b/bindings/udisks/uDisks_device.mli
@@ -0,0 +1,240 @@
+(*
+ * uDisks_device.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UDisks device interface *)
+
+include OBus_proxy.Private
+
+(** {6 Methods} *)
+
+type benchmark_result = {
+  bench_read_transfer_rate_results : (int64 * float) list;
+  (** An array of pairs where the first element is the offset and the
+      second element is the measured read transfer rate (in bytes/sec)
+      at the given offset. *)
+  bench_write_transfer_rate_results : (int64 * float) list;
+  (** An array of pairs where the first element is the offset and the
+      second element is the measured read transfer rate (in bytes/sec)
+      at the given offset. This is an empty array unless write
+      benchmarking has been requested. *)
+  bench_access_time_results : (int64 * float) list;
+  (** An array of pairs where the first element is the offset and the
+      second element the amount of time (in seconds) it took to seek
+      to the position. *)
+}
+
+val drive_benchmark : t -> do_write_benchmark : bool -> options : string list -> benchmark_result Lwt.t
+
+val drive_ata_smart_initiate_selftest : t -> test : string -> options : string list -> unit Lwt.t
+val drive_ata_smart_refresh_data : t -> options : string list -> unit Lwt.t
+
+type spindown_timeout_cookie
+
+val drive_set_spindown_timeout : t -> timeout_seconds : int -> options : string list -> spindown_timeout_cookie Lwt.t
+val drive_unset_spindown_timeout : t -> cookie : spindown_timeout_cookie -> unit Lwt.t
+
+val drive_detach : t -> options : string list -> unit Lwt.t
+val drive_eject : t -> options : string list -> unit Lwt.t
+val drive_poll_media : t -> unit Lwt.t
+
+type inhibit_polling_cookie
+
+val drive_inhibit_polling : t -> options : string list -> inhibit_polling_cookie Lwt.t
+val drive_uninhibit_polling : t -> cookie : inhibit_polling_cookie -> unit Lwt.t
+
+val linux_md_check : t -> options : string list -> int64 Lwt.t
+val linux_lvm2_lvstop : t -> options : string list -> unit Lwt.t
+
+val linux_md_stop : t -> options : string list -> unit Lwt.t
+val linux_md_remove_component : t -> component : t -> options : string list -> unit Lwt.t
+val linux_md_expand : t -> components : t list -> options : string list -> unit Lwt.t
+val linux_md_add_spare : t -> component : t -> options : string list -> unit Lwt.t
+
+val luks_change_passphrase : t -> current_passphrase : string -> new_passphrase : string -> unit Lwt.t
+val luks_lock : t -> options : string list -> unit Lwt.t
+val luks_unlock : t -> passphrase : string -> options : string list -> t Lwt.t
+
+type process = {
+  pr_pid : int;
+  pr_uid : int;
+  pr_comamnd_line : string;
+}
+
+val filesystem_list_open_files : t -> process list Lwt.t
+val filesystem_check : t -> options : string list -> bool Lwt.t
+val filesystem_unmount : t -> options : string list -> unit Lwt.t
+val filesystem_mount : t -> filesystem_type : string -> options : string list -> string Lwt.t
+val filesystem_set_label : t -> new_label : string -> unit Lwt.t
+val filesystem_create : t -> fstype : string -> options : string list -> unit Lwt.t
+
+val partition_modify : t -> typ : string -> label : string -> flags : string list -> unit Lwt.t
+val partition_create : t -> offset : int64 -> size : int64 -> typ : string -> label : string -> flags : string list -> options : string list -> fstype : string -> fsoptions : string list -> t Lwt.t
+val partition_delete : t -> options : string list -> unit Lwt.t
+val partition_table_create : t -> scheme : string -> options : string list -> unit Lwt.t
+
+val job_cancel : t -> unit Lwt.t
+
+(** {6 Signals} *)
+
+(** A job description *)
+type job = {
+  job_in_progress : bool;
+  (** Whether a job is currently in progress *)
+
+  job_id : string;
+  (** The identifier of the job *)
+
+  job_initiated_by_uid : int;
+  (** he UNIX user id of the user who initiated the job *)
+
+  job_is_cancellable : bool;
+  (** Whether the job is cancellable *)
+
+  job_cur_task_percentage : float;
+  (** Percentage completed of current task (between 0 and 100,
+      negative if unknown) *)
+}
+
+val job_changed : t -> job OBus_signal.t
+val changed : t -> unit OBus_signal.t
+
+(** {6 Properties} *)
+
+val linux_dmmp_parameters : t -> string OBus_property.r
+val linux_dmmp_slaves : t -> t list OBus_property.r
+val linux_dmmp_name : t -> string OBus_property.r
+val linux_dmmp_component_holder : t -> t OBus_property.r
+val linux_lvm2_lvgroup_uuid : t -> string OBus_property.r
+val linux_lvm2_lvgroup_name : t -> string OBus_property.r
+val linux_lvm2_lvuuid : t -> string OBus_property.r
+val linux_lvm2_lvname : t -> string OBus_property.r
+val linux_lvm2_pvgroup_logical_volumes : t -> string list OBus_property.r
+val linux_lvm2_pvgroup_physical_volumes : t -> string list OBus_property.r
+val linux_lvm2_pvgroup_extent_size : t -> int64 OBus_property.r
+val linux_lvm2_pvgroup_sequence_number : t -> int64 OBus_property.r
+val linux_lvm2_pvgroup_unallocated_size : t -> int64 OBus_property.r
+val linux_lvm2_pvgroup_size : t -> int64 OBus_property.r
+val linux_lvm2_pvgroup_uuid : t -> string OBus_property.r
+val linux_lvm2_pvgroup_name : t -> string OBus_property.r
+val linux_lvm2_pvnum_metadata_areas : t -> int OBus_property.r
+val linux_lvm2_pvuuid : t -> string OBus_property.r
+val linux_md_sync_speed : t -> int64 OBus_property.r
+val linux_md_sync_percentage : t -> float OBus_property.r
+val linux_md_sync_action : t -> string OBus_property.r
+val linux_md_is_degraded : t -> bool OBus_property.r
+val linux_md_slaves : t -> t list OBus_property.r
+val linux_md_version : t -> string OBus_property.r
+val linux_md_num_raid_devices : t -> int OBus_property.r
+val linux_md_name : t -> string OBus_property.r
+val linux_md_home_host : t -> string OBus_property.r
+val linux_md_uuid : t -> string OBus_property.r
+val linux_md_level : t -> string OBus_property.r
+val linux_md_state : t -> string OBus_property.r
+val linux_md_component_state : t -> string list OBus_property.r
+val linux_md_component_holder : t -> t OBus_property.r
+val linux_md_component_version : t -> string OBus_property.r
+val linux_md_component_home_host : t -> string OBus_property.r
+val linux_md_component_name : t -> string OBus_property.r
+val linux_md_component_uuid : t -> string OBus_property.r
+val linux_md_component_num_raid_devices : t -> int OBus_property.r
+val linux_md_component_position : t -> int OBus_property.r
+val linux_md_component_level : t -> string OBus_property.r
+val drive_ata_smart_blob : t -> string OBus_property.r
+val drive_ata_smart_status : t -> string OBus_property.r
+val drive_ata_smart_time_collected : t -> int64 OBus_property.r
+val drive_ata_smart_is_available : t -> bool OBus_property.r
+val optical_disc_num_sessions : t -> int OBus_property.r
+val optical_disc_num_audio_tracks : t -> int OBus_property.r
+val optical_disc_num_tracks : t -> int OBus_property.r
+val optical_disc_is_closed : t -> bool OBus_property.r
+val optical_disc_is_appendable : t -> bool OBus_property.r
+val optical_disc_is_blank : t -> bool OBus_property.r
+val drive_similar_devices : t -> t list OBus_property.r
+val drive_ports : t -> UDisks_port.t list OBus_property.r
+val drive_adapter : t -> UDisks_adapter.t OBus_property.r
+val drive_is_rotational : t -> bool OBus_property.r
+val drive_can_spindown : t -> bool OBus_property.r
+val drive_can_detach : t -> bool OBus_property.r
+val drive_is_media_ejectable : t -> bool OBus_property.r
+val drive_media : t -> string OBus_property.r
+val drive_media_compatibility : t -> string list OBus_property.r
+val drive_connection_speed : t -> int64 OBus_property.r
+val drive_connection_interface : t -> string OBus_property.r
+val drive_write_cache : t -> string OBus_property.r
+val drive_rotation_rate : t -> int OBus_property.r
+val drive_wwn : t -> string OBus_property.r
+val drive_serial : t -> string OBus_property.r
+val drive_revision : t -> string OBus_property.r
+val drive_model : t -> string OBus_property.r
+val drive_vendor : t -> string OBus_property.r
+val partition_table_count : t -> int OBus_property.r
+val partition_table_scheme : t -> string OBus_property.r
+val partition_alignment_offset : t -> int64 OBus_property.r
+val partition_size : t -> int64 OBus_property.r
+val partition_offset : t -> int64 OBus_property.r
+val partition_number : t -> int OBus_property.r
+val partition_flags : t -> string list OBus_property.r
+val partition_uuid : t -> string OBus_property.r
+val partition_label : t -> string OBus_property.r
+val partition_type : t -> string OBus_property.r
+val partition_scheme : t -> string OBus_property.r
+val partition_slave : t -> t OBus_property.r
+val luks_cleartext_unlocked_by_uid : t -> int OBus_property.r
+val luks_cleartext_slave : t -> t OBus_property.r
+val luks_holder : t -> t OBus_property.r
+val id_label : t -> string OBus_property.r
+val id_uuid : t -> string OBus_property.r
+val id_version : t -> string OBus_property.r
+val id_type : t -> string OBus_property.r
+val id_usage : t -> string OBus_property.r
+val job_percentage : t -> float OBus_property.r
+val job_is_cancellable : t -> bool OBus_property.r
+val job_initiated_by_uid : t -> int OBus_property.r
+val job_id : t -> string OBus_property.r
+val job_in_progress : t -> bool OBus_property.r
+val device_presentation_icon_name : t -> string OBus_property.r
+val device_presentation_name : t -> string OBus_property.r
+val device_presentation_nopolicy : t -> bool OBus_property.r
+val device_presentation_hide : t -> bool OBus_property.r
+val device_block_size : t -> int64 OBus_property.r
+val device_size : t -> int64 OBus_property.r
+val device_is_linux_dmmp : t -> bool OBus_property.r
+val device_is_linux_dmmp_component : t -> bool OBus_property.r
+val device_is_linux_lvm2_pv : t -> bool OBus_property.r
+val device_is_linux_lvm2_lv : t -> bool OBus_property.r
+val device_is_linux_md : t -> bool OBus_property.r
+val device_is_linux_md_component : t -> bool OBus_property.r
+val device_is_luks_cleartext : t -> bool OBus_property.r
+val device_is_luks : t -> bool OBus_property.r
+val device_mounted_by_uid : t -> int OBus_property.r
+val device_mount_paths : t -> string list OBus_property.r
+val device_is_mounted : t -> bool OBus_property.r
+val device_is_optical_disc : t -> bool OBus_property.r
+val device_is_drive : t -> bool OBus_property.r
+val device_is_read_only : t -> bool OBus_property.r
+val device_is_media_change_detection_inhibited : t -> bool OBus_property.r
+val device_is_media_change_detection_inhibitable : t -> bool OBus_property.r
+val device_is_media_change_detection_polling : t -> bool OBus_property.r
+val device_is_media_change_detected : t -> bool OBus_property.r
+val device_is_media_available : t -> bool OBus_property.r
+val device_is_removable : t -> bool OBus_property.r
+val device_is_partition_table : t -> bool OBus_property.r
+val device_is_partition : t -> bool OBus_property.r
+val device_is_system_internal : t -> bool OBus_property.r
+val device_file_by_path : t -> string list OBus_property.r
+val device_file_by_id : t -> string list OBus_property.r
+val device_file_presentation : t -> string OBus_property.r
+val device_file : t -> string OBus_property.r
+val device_minor : t -> int64 OBus_property.r
+val device_major : t -> int64 OBus_property.r
+val device_media_detection_time : t -> int64 OBus_property.r
+val device_detection_time : t -> int64 OBus_property.r
+val native_path : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/udisks/uDisks_expander.ml b/bindings/udisks/uDisks_expander.ml
new file mode 100644
index 0000000..25e3cd8
--- /dev/null
+++ b/bindings/udisks/uDisks_expander.ml
@@ -0,0 +1,45 @@
+(*
+ * uDisks_expander.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+include OBus_proxy.Private
+
+open UDisks_interfaces.Org_freedesktop_UDisks_Expander
+
+let changed proxy =
+  OBus_signal.make s_Changed proxy
+
+let native_path proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy
+
+let vendor proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy
+
+let model proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy
+
+let revision proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_Revision proxy
+
+let num_ports proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy)
+
+let upstream_ports proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> List.map (fun path -> UDisks_port.of_proxy ( OBus_proxy.make (OBus_context.sender context) path)) x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_UpstreamPorts proxy)
+
+let adapter proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x))
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy)
+
+let properties proxy =
+  OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface
diff --git a/bindings/udisks/uDisks_expander.mli b/bindings/udisks/uDisks_expander.mli
new file mode 100644
index 0000000..ccdbbab
--- /dev/null
+++ b/bindings/udisks/uDisks_expander.mli
@@ -0,0 +1,28 @@
+(*
+ * uDisks_expander.mli
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UDisks expander interface *)
+
+include OBus_proxy.Private
+
+(** {6 Signals} *)
+
+val changed : t -> unit OBus_signal.t
+
+(** {6 Properties} *)
+
+val native_path : t -> string OBus_property.r
+val vendor : t -> string OBus_property.r
+val model : t -> string OBus_property.r
+val revision : t -> string OBus_property.r
+val num_ports : t -> int OBus_property.r
+val upstream_ports : t -> UDisks_port.t list OBus_property.r
+val adapter : t -> UDisks_adapter.t OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/udisks/uDisks_interfaces.obus b/bindings/udisks/uDisks_interfaces.obus
new file mode 100644
index 0000000..02f73d4
--- /dev/null
+++ b/bindings/udisks/uDisks_interfaces.obus
@@ -0,0 +1,249 @@
+(*
+ * uDisks_interfaces.obus
+ * ----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.UDisks {
+  method EnumerateAdapters : () -> (devices : object_path array)
+  method EnumerateExpanders : () -> (devices : object_path array)
+  method EnumeratePorts : () -> (devices : object_path array)
+  method EnumerateDevices : () -> (devices : object_path array)
+  method EnumerateDeviceFiles : () -> (device_files : string array)
+  method FindDeviceByDeviceFile : (device_file : string) -> (device : object_path)
+  method FindDeviceByMajorMinor : (device_major : int64, device_minor : int64) -> (device : object_path)
+  method DriveInhibitAllPolling : (options : string array) -> (cookie : string)
+  method DriveUninhibitAllPolling : (cookie : string) -> ()
+  method DriveSetAllSpindownTimeouts : (timeout_seconds : int32, options : string array) -> (cookie : string)
+  method DriveUnsetAllSpindownTimeouts : (cookie : string) -> ()
+  method LinuxLvm2VGStart : (uuid : string, options : string array) -> ()
+  method LinuxLvm2VGStop : (uuid : string, options : string array) -> ()
+  method LinuxLvm2VGSetName : (uuid : string, name : string) -> ()
+  method LinuxLvm2VGAddPV : (uuid : string, physical_volume : object_path, options : string array) -> ()
+  method LinuxLvm2VGRemovePV : (vg_uuid : string, pv_uuid : string, options : string array) -> ()
+  method LinuxLvm2LVSetName : (group_uuid : string, uuid : string, name : string) -> ()
+  method LinuxLvm2LVStart : (group_uuid : string, uuid : string, options : string array) -> ()
+  method LinuxLvm2LVRemove : (group_uuid : string, uuid : string, options : string array) -> ()
+  method LinuxLvm2LVCreate : (group_uuid : string, name : string, size : uint64, num_stripes : uint32, stripe_size : uint64, num_mirrors : uint32, options : string array, fstype : string, fsoptions : string array) -> (created_device : object_path)
+  method LinuxMdStart : (components : object_path array, options : string array) -> (device : object_path)
+  method LinuxMdCreate : (components : object_path array, level : string, stripe_size : uint64, name : string, options : string array) -> (device : object_path)
+  method Inhibit : () -> (cookie : string)
+  method Uninhibit : (cookie : string) -> ()
+  signal DeviceAdded : (device : object_path)
+  signal DeviceRemoved : (device : object_path)
+  signal DeviceChanged : (device : object_path)
+  signal DeviceJobChanged : (device : object_path, job_in_progress : boolean, job_is_cancellable : boolean, job_id : string, job_num_tasks : int32, job_cur_task : int32, job_cur_task_id : string, job_cur_task_percentage : double)
+  signal AdapterAdded : (adapter : object_path)
+  signal AdapterRemoved : (adapter : object_path)
+  signal AdapterChanged : (adapter : object_path)
+  signal ExpanderAdded : (expander : object_path)
+  signal ExpanderRemoved : (expander : object_path)
+  signal ExpanderChanged : (expander : object_path)
+  signal PortAdded : (port : object_path)
+  signal PortRemoved : (port : object_path)
+  signal PortChanged : (port : object_path)
+  property_r DaemonVersion : string
+  property_r DaemonIsInhibited : boolean
+  property_r SupportsLuksDevices : boolean
+  property_r KnownFilesystems : (string * string * boolean * boolean * boolean * uint32 * boolean * boolean * boolean * boolean * boolean * boolean * boolean * boolean) array
+}
+
+interface org.freedesktop.UDisks.Adapter {
+  signal Changed : ()
+  property_r NativePath : string
+  property_r Vendor : string
+  property_r Model : string
+  property_r Driver : string
+  property_r NumPorts : uint32
+  property_r Fabric : string
+}
+
+interface org.freedesktop.UDisks.Device {
+  method JobCancel : () -> ()
+  method PartitionTableCreate : (scheme : string, options : string array) -> ()
+  method PartitionDelete : (options : string array) -> ()
+  method PartitionCreate : (offset : uint64, size : uint64, type : string, label : string, flags : string array, options : string array, fstype : string, fsoptions : string array) -> (created_device : object_path)
+  method PartitionModify : (type : string, label : string, flags : string array) -> ()
+  method FilesystemCreate : (fstype : string, options : string array) -> ()
+  method FilesystemSetLabel : (new_label : string) -> ()
+  method FilesystemMount : (filesystem_type : string, options : string array) -> (mount_path : string)
+  method FilesystemUnmount : (options : string array) -> ()
+  method FilesystemCheck : (options : string array) -> (is_clean : boolean)
+  method FilesystemListOpenFiles : () -> (processes : (uint32 * uint32 * string) array)
+  method LuksUnlock : (passphrase : string, options : string array) -> (cleartext_device : object_path)
+  method LuksLock : (options : string array) -> ()
+  method LuksChangePassphrase : (current_passphrase : string, new_passphrase : string) -> ()
+  method LinuxMdAddSpare : (component : object_path, options : string array) -> ()
+  method LinuxMdExpand : (components : object_path array, options : string array) -> ()
+  method LinuxMdRemoveComponent : (component : object_path, options : string array) -> ()
+  method LinuxMdStop : (options : string array) -> ()
+  method LinuxLvm2LVStop : (options : string array) -> ()
+  method LinuxMdCheck : (options : string array) -> (number_of_errors : uint64)
+  method DriveInhibitPolling : (options : string array) -> (cookie : string)
+  method DriveUninhibitPolling : (cookie : string) -> ()
+  method DrivePollMedia : () -> ()
+  method DriveEject : (options : string array) -> ()
+  method DriveDetach : (options : string array) -> ()
+  method DriveSetSpindownTimeout : (timeout_seconds : int32, options : string array) -> (cookie : string)
+  method DriveUnsetSpindownTimeout : (cookie : string) -> ()
+  method DriveAtaSmartRefreshData : (options : string array) -> ()
+  method DriveAtaSmartInitiateSelftest : (test : string, options : string array) -> ()
+  method DriveBenchmark : (do_write_benchmark : boolean, options : string array) -> (read_transfer_rate_results : (uint64 * double) array, write_transfer_rate_results : (uint64 * double) array, access_time_results : (uint64 * double) array)
+  signal Changed : ()
+  signal JobChanged : (job_in_progress : boolean, job_is_cancellable : boolean, job_id : string, job_initiated_by_uid : uint32, job_percentage : double)
+  property_r NativePath : string
+  property_r DeviceDetectionTime : uint64
+  property_r DeviceMediaDetectionTime : uint64
+  property_r DeviceMajor : int64
+  property_r DeviceMinor : int64
+  property_r DeviceFile : string
+  property_r DeviceFilePresentation : string
+  property_r DeviceFileById : string array
+  property_r DeviceFileByPath : string array
+  property_r DeviceIsSystemInternal : boolean
+  property_r DeviceIsPartition : boolean
+  property_r DeviceIsPartitionTable : boolean
+  property_r DeviceIsRemovable : boolean
+  property_r DeviceIsMediaAvailable : boolean
+  property_r DeviceIsMediaChangeDetected : boolean
+  property_r DeviceIsMediaChangeDetectionPolling : boolean
+  property_r DeviceIsMediaChangeDetectionInhibitable : boolean
+  property_r DeviceIsMediaChangeDetectionInhibited : boolean
+  property_r DeviceIsReadOnly : boolean
+  property_r DeviceIsDrive : boolean
+  property_r DeviceIsOpticalDisc : boolean
+  property_r DeviceIsMounted : boolean
+  property_r DeviceMountPaths : string array
+  property_r DeviceMountedByUid : uint32
+  property_r DeviceIsLuks : boolean
+  property_r DeviceIsLuksCleartext : boolean
+  property_r DeviceIsLinuxMdComponent : boolean
+  property_r DeviceIsLinuxMd : boolean
+  property_r DeviceIsLinuxLvm2LV : boolean
+  property_r DeviceIsLinuxLvm2PV : boolean
+  property_r DeviceIsLinuxDmmpComponent : boolean
+  property_r DeviceIsLinuxDmmp : boolean
+  property_r DeviceIsLinuxLoop : boolean
+  property_r DeviceSize : uint64
+  property_r DeviceBlockSize : uint64
+  property_r DevicePresentationHide : boolean
+  property_r DevicePresentationNopolicy : boolean
+  property_r DevicePresentationName : string
+  property_r DevicePresentationIconName : string
+  property_r JobInProgress : boolean
+  property_r JobId : string
+  property_r JobInitiatedByUid : uint32
+  property_r JobIsCancellable : boolean
+  property_r JobPercentage : double
+  property_r IdUsage : string
+  property_r IdType : string
+  property_r IdVersion : string
+  property_r IdUuid : string
+  property_r IdLabel : string
+  property_r LuksHolder : object_path
+  property_r LuksCleartextSlave : object_path
+  property_r LuksCleartextUnlockedByUid : uint32
+  property_r PartitionSlave : object_path
+  property_r PartitionScheme : string
+  property_r PartitionType : string
+  property_r PartitionLabel : string
+  property_r PartitionUuid : string
+  property_r PartitionFlags : string array
+  property_r PartitionNumber : int32
+  property_r PartitionOffset : uint64
+  property_r PartitionSize : uint64
+  property_r PartitionAlignmentOffset : uint64
+  property_r PartitionTableScheme : string
+  property_r PartitionTableCount : int32
+  property_r DriveVendor : string
+  property_r DriveModel : string
+  property_r DriveRevision : string
+  property_r DriveSerial : string
+  property_r DriveWwn : string
+  property_r DriveRotationRate : uint32
+  property_r DriveWriteCache : string
+  property_r DriveConnectionInterface : string
+  property_r DriveConnectionSpeed : uint64
+  property_r DriveMediaCompatibility : string array
+  property_r DriveMedia : string
+  property_r DriveIsMediaEjectable : boolean
+  property_r DriveCanDetach : boolean
+  property_r DriveCanSpindown : boolean
+  property_r DriveIsRotational : boolean
+  property_r DriveAdapter : object_path
+  property_r DrivePorts : object_path array
+  property_r DriveSimilarDevices : object_path array
+  property_r OpticalDiscIsBlank : boolean
+  property_r OpticalDiscIsAppendable : boolean
+  property_r OpticalDiscIsClosed : boolean
+  property_r OpticalDiscNumTracks : uint32
+  property_r OpticalDiscNumAudioTracks : uint32
+  property_r OpticalDiscNumSessions : uint32
+  property_r DriveAtaSmartIsAvailable : boolean
+  property_r DriveAtaSmartTimeCollected : uint64
+  property_r DriveAtaSmartStatus : string
+  property_r DriveAtaSmartBlob : byte array
+  property_r LinuxMdComponentLevel : string
+  property_r LinuxMdComponentPosition : int32
+  property_r LinuxMdComponentNumRaidDevices : int32
+  property_r LinuxMdComponentUuid : string
+  property_r LinuxMdComponentName : string
+  property_r LinuxMdComponentHomeHost : string
+  property_r LinuxMdComponentVersion : string
+  property_r LinuxMdComponentHolder : object_path
+  property_r LinuxMdComponentState : string array
+  property_r LinuxMdState : string
+  property_r LinuxMdLevel : string
+  property_r LinuxMdUuid : string
+  property_r LinuxMdHomeHost : string
+  property_r LinuxMdName : string
+  property_r LinuxMdNumRaidDevices : int32
+  property_r LinuxMdVersion : string
+  property_r LinuxMdSlaves : object_path array
+  property_r LinuxMdIsDegraded : boolean
+  property_r LinuxMdSyncAction : string
+  property_r LinuxMdSyncPercentage : double
+  property_r LinuxMdSyncSpeed : uint64
+  property_r LinuxLvm2PVUuid : string
+  property_r LinuxLvm2PVNumMetadataAreas : uint32
+  property_r LinuxLvm2PVGroupName : string
+  property_r LinuxLvm2PVGroupUuid : string
+  property_r LinuxLvm2PVGroupSize : uint64
+  property_r LinuxLvm2PVGroupUnallocatedSize : uint64
+  property_r LinuxLvm2PVGroupSequenceNumber : uint64
+  property_r LinuxLvm2PVGroupExtentSize : uint64
+  property_r LinuxLvm2PVGroupPhysicalVolumes : string array
+  property_r LinuxLvm2PVGroupLogicalVolumes : string array
+  property_r LinuxLvm2LVName : string
+  property_r LinuxLvm2LVUuid : string
+  property_r LinuxLvm2LVGroupName : string
+  property_r LinuxLvm2LVGroupUuid : string
+  property_r LinuxDmmpComponentHolder : object_path
+  property_r LinuxDmmpName : string
+  property_r LinuxDmmpSlaves : object_path array
+  property_r LinuxDmmpParameters : string
+  property_r LinuxLoopFilename : string
+}
+
+interface org.freedesktop.UDisks.Expander {
+  signal Changed : ()
+  property_r NativePath : string
+  property_r Vendor : string
+  property_r Model : string
+  property_r Revision : string
+  property_r NumPorts : uint32
+  property_r UpstreamPorts : object_path array
+  property_r Adapter : object_path
+}
+
+interface org.freedesktop.UDisks.Port {
+  signal Changed : ()
+  property_r NativePath : string
+  property_r Adapter : object_path
+  property_r Parent : object_path
+  property_r Number : int32
+  property_r ConnectorType : string
+}
diff --git a/bindings/udisks/uDisks_monitor.ml b/bindings/udisks/uDisks_monitor.ml
new file mode 100644
index 0000000..faf9de1
--- /dev/null
+++ b/bindings/udisks/uDisks_monitor.ml
@@ -0,0 +1,35 @@
+(*
+ * uDisks_monitor.ml
+ * -----------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt_react
+open Lwt
+
+module String_map = Map.Make(String)
+
+let changed interface =
+  OBus_member.Signal.make
+    ~interface
+    ~member:"Changed"
+    ~args:OBus_value.arg0
+    ~annotations:[]
+
+let monitor proxy interface switch =
+  let%lwt event =
+    OBus_signal.connect ~switch
+      (OBus_signal.with_context
+         (OBus_signal.make (changed interface) proxy))
+  and context, dict = OBus_property.get_all_no_cache proxy interface in
+  return (S.hold
+            ~eq:(String_map.equal (=))
+            (OBus_property.map_of_list context dict)
+            (E.map_s
+               (fun (context, ()) ->
+                  let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in
+                  return (OBus_property.map_of_list context dict))
+               event))
diff --git a/bindings/udisks/uDisks_monitor.mli b/bindings/udisks/uDisks_monitor.mli
new file mode 100644
index 0000000..bc31320
--- /dev/null
+++ b/bindings/udisks/uDisks_monitor.mli
@@ -0,0 +1,13 @@
+(*
+ * uDisks_monitor.mli
+ * ------------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Properties monitoring *)
+
+val monitor : OBus_property.monitor
+  (** Monitor for properties of udisk interfaces. *)
diff --git a/bindings/udisks/uDisks_port.ml b/bindings/udisks/uDisks_port.ml
new file mode 100644
index 0000000..7aa2e31
--- /dev/null
+++ b/bindings/udisks/uDisks_port.ml
@@ -0,0 +1,39 @@
+(*
+ * uDisks_port.ml
+ * --------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+include OBus_proxy.Private
+
+open UDisks_interfaces.Org_freedesktop_UDisks_Port
+
+let changed proxy =
+  OBus_signal.make s_Changed proxy
+
+let native_path proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy
+
+let adapter proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x))
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy)
+
+let parent proxy =
+  OBus_property.map_r_with_context
+    (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x))
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_Parent proxy)
+
+let number proxy =
+  OBus_property.map_r
+    (fun x -> Int32.to_int x)
+    (OBus_property.make ~monitor:UDisks_monitor.monitor p_Number proxy)
+
+let connector_type proxy =
+  OBus_property.make ~monitor:UDisks_monitor.monitor p_ConnectorType proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface
diff --git a/bindings/udisks/uDisks_port.mli b/bindings/udisks/uDisks_port.mli
new file mode 100644
index 0000000..28aa67e
--- /dev/null
+++ b/bindings/udisks/uDisks_port.mli
@@ -0,0 +1,26 @@
+(*
+ * uDisks_port.mli
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UDisks port interface *)
+
+include OBus_proxy.Private
+
+(** {6 Signals} *)
+
+val changed : t -> unit OBus_signal.t
+
+(** {6 Properties} *)
+
+val connector_type : t -> string OBus_property.r
+val number : t -> int OBus_property.r
+val parent : t -> UDisks_adapter.t OBus_property.r
+val adapter : t -> UDisks_adapter.t OBus_property.r
+val native_path : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/upower/dune b/bindings/upower/dune
new file mode 100644
index 0000000..23caec5
--- /dev/null
+++ b/bindings/upower/dune
@@ -0,0 +1,12 @@
+(library
+ (name obus_upower)
+ (public_name obus.upower)
+ (wrapped false)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(rule
+ (targets uPower_interfaces.ml uPower_interfaces.mli)
+ (deps    uPower_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o uPower_interfaces %{deps})))
diff --git a/bindings/upower/uPower.ml b/bindings/upower/uPower.ml
new file mode 100644
index 0000000..caaf4d6
--- /dev/null
+++ b/bindings/upower/uPower.ml
@@ -0,0 +1,97 @@
+(*
+ * uPower.ml
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+include OBus_peer.Private
+
+let general_error = "org.freedesktop.UPower.GeneralError"
+
+let daemon () =
+  let%lwt bus = OBus_bus.system () in
+  return (OBus_peer.make bus "org.freedesktop.UPower")
+
+open UPower_interfaces.Org_freedesktop_UPower
+
+let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "UPower"]
+
+let enumerate_devices daemon =
+  let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateDevices (proxy daemon) () in
+  return
+    (List.map
+       (fun path ->
+          UPower_device.of_proxy
+            (OBus_proxy.make (OBus_context.sender context) path))
+       devices)
+
+let device_added daemon =
+  OBus_signal.map_with_context
+    (fun context device ->
+       UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device)))
+    (OBus_signal.make s_DeviceAdded (proxy daemon))
+
+let device_removed daemon =
+  OBus_signal.map_with_context
+    (fun context device ->
+       UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device)))
+    (OBus_signal.make s_DeviceRemoved (proxy daemon))
+
+let device_changed daemon =
+  OBus_signal.map_with_context
+    (fun context device ->
+       UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device)))
+    (OBus_signal.make s_DeviceChanged (proxy daemon))
+
+let changed daemon =
+  OBus_signal.make s_Changed (proxy daemon)
+
+let sleeping daemon =
+  OBus_signal.make s_Sleeping (proxy daemon)
+
+let resuming daemon =
+  OBus_signal.make s_Resuming (proxy daemon)
+
+let about_to_sleep daemon =
+  OBus_method.call m_AboutToSleep (proxy daemon) ()
+
+let suspend daemon =
+  OBus_method.call m_Suspend (proxy daemon) ()
+
+let suspend_allowed daemon =
+  OBus_method.call m_SuspendAllowed (proxy daemon) ()
+
+let hibernate daemon =
+  OBus_method.call m_Hibernate (proxy daemon) ()
+
+let hibernate_allowed daemon =
+  OBus_method.call m_HibernateAllowed (proxy daemon) ()
+
+let daemon_version daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_DaemonVersion (proxy daemon)
+
+let can_suspend daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_CanSuspend (proxy daemon)
+
+let can_hibernate daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_CanHibernate (proxy daemon)
+
+let on_battery daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_OnBattery (proxy daemon)
+
+let on_low_battery daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_OnLowBattery (proxy daemon)
+
+let lid_is_closed daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsClosed (proxy daemon)
+
+let lid_is_present daemon =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsPresent (proxy daemon)
+
+let properties daemon =
+  OBus_property.group ~monitor:UPower_monitor.monitor (proxy daemon) interface
diff --git a/bindings/upower/uPower.mli b/bindings/upower/uPower.mli
new file mode 100644
index 0000000..46c2fcb
--- /dev/null
+++ b/bindings/upower/uPower.mli
@@ -0,0 +1,47 @@
+(*
+ * uPower.mli
+ * ----------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UPower main interface *)
+
+include OBus_peer.Private
+
+val daemon : unit -> t Lwt.t
+  (** [daemon ()] returns the peer object for the upower daemon *)
+
+val general_error : OBus_error.name
+
+(** {6 Methods} *)
+
+val hibernate_allowed : t -> bool Lwt.t
+val hibernate : t -> unit Lwt.t
+val suspend_allowed : t -> bool Lwt.t
+val suspend : t -> unit Lwt.t
+val about_to_sleep : t -> unit Lwt.t
+val enumerate_devices : t -> UPower_device.t list Lwt.t
+
+(** {6 Signals} *)
+
+val resuming : t -> unit OBus_signal.t
+val sleeping : t -> unit OBus_signal.t
+val changed : t -> unit OBus_signal.t
+val device_changed : t -> UPower_device.t OBus_signal.t
+val device_removed : t -> UPower_device.t OBus_signal.t
+val device_added : t -> UPower_device.t OBus_signal.t
+
+(** {6 Properties} *)
+
+val lid_is_present : t -> bool OBus_property.r
+val lid_is_closed : t -> bool OBus_property.r
+val on_low_battery : t -> bool OBus_property.r
+val on_battery : t -> bool OBus_property.r
+val can_hibernate : t -> bool OBus_property.r
+val can_suspend : t -> bool OBus_property.r
+val daemon_version : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/upower/uPower_device.ml b/bindings/upower/uPower_device.ml
new file mode 100644
index 0000000..314e9cc
--- /dev/null
+++ b/bindings/upower/uPower_device.ml
@@ -0,0 +1,177 @@
+(*
+ * uPower_device.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+include OBus_proxy.Private
+
+let general_error = "org.freedesktop.UPower.Device.GeneralError"
+
+type typ =
+    [ `Unknown
+    | `Line_power
+    | `Battery
+    | `Ups
+    | `Monitor
+    | `Mouse
+    | `Keyboard
+    | `Pda
+    | `Phone ]
+
+type state =
+    [ `Unknown
+    | `Charging
+    | `Discharging
+    | `Empty
+    | `Fully_charged
+    | `Pending_charge
+    | `Pending_discharge ]
+
+type technology =
+    [ `Unknown
+    | `Lithium_ion
+    | `Lithium_polymer
+    | `Lithium_iron_phosphate
+    | `Lead_acid
+    | `Nickel_cadmium
+    | `Nickel_metal_hydride ]
+
+open UPower_interfaces.Org_freedesktop_UPower_Device
+
+let refresh proxy =
+  OBus_method.call m_Refresh proxy ()
+
+let changed proxy =
+  OBus_signal.make s_Changed proxy
+
+let get_history proxy ~typ ~timespan ~resolution =
+  let timespan = Int32.of_int timespan in
+  let resolution = Int32.of_int resolution in
+  let%lwt data = OBus_method.call m_GetHistory proxy (typ, timespan, resolution) in
+  let data = List.map (fun (x1, x2, x3) -> (Int32.to_int x1, x2, Int32.to_int x3)) data in
+  return data
+
+let get_statistics proxy ~typ =
+  OBus_method.call m_GetStatistics proxy typ
+
+let native_path proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_NativePath proxy
+
+let vendor proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Vendor proxy
+
+let model proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Model proxy
+
+let serial proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Serial proxy
+
+let update_time proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_UpdateTime proxy
+
+let typ proxy =
+  OBus_property.map_r
+    (function
+       | 0l -> `Unknown
+       | 1l -> `Line_power
+       | 2l -> `Battery
+       | 3l -> `Ups
+       | 4l -> `Monitor
+       | 5l -> `Mouse
+       | 6l -> `Keyboard
+       | 7l -> `Pda
+       | 8l -> `Phone
+       | n -> Printf.ksprintf failwith "invalid device type: %ld" n)
+    (OBus_property.make ~monitor:UPower_monitor.monitor p_Type proxy)
+
+let power_supply proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_PowerSupply proxy
+
+let has_history proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_HasHistory proxy
+
+let has_statistics proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_HasStatistics proxy
+
+let online proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Online proxy
+
+let energy proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Energy proxy
+
+let energy_empty proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyEmpty proxy
+
+let energy_full proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyFull proxy
+
+let energy_full_design proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyFullDesign proxy
+
+let energy_rate proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyRate proxy
+
+let voltage proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Voltage proxy
+
+let time_to_empty proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_TimeToEmpty proxy
+
+let time_to_full proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_TimeToFull proxy
+
+let percentage proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Percentage proxy
+
+let is_present proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_IsPresent proxy
+
+let state proxy =
+  OBus_property.map_r
+    (function
+       | 0l -> `Unknown
+       | 1l -> `Charging
+       | 2l -> `Discharging
+       | 3l -> `Empty
+       | 4l -> `Fully_charged
+       | 5l -> `Pending_charge
+       | 6l -> `Pending_discharge
+       | n -> Printf.ksprintf failwith "invalid device state: %ld" n)
+    (OBus_property.make ~monitor:UPower_monitor.monitor p_State proxy)
+
+let is_rechargeable proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_IsRechargeable proxy
+
+let capacity proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_Capacity proxy
+
+let technology proxy =
+  OBus_property.map_r
+    (function
+       | 0l -> `Unknown
+       | 1l -> `Lithium_ion
+       | 2l -> `Lithium_polymer
+       | 3l -> `Lithium_iron_phosphate
+       | 4l -> `Lead_acid
+       | 5l -> `Nickel_cadmium
+       | 6l -> `Nickel_metal_hydride
+       | n -> Printf.ksprintf failwith "invalid technolofy number: %ld" n)
+    (OBus_property.make ~monitor:UPower_monitor.monitor p_Technology proxy)
+
+let recall_notice proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_RecallNotice proxy
+
+let recall_vendor proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_RecallVendor proxy
+
+let recall_url proxy =
+  OBus_property.make ~monitor:UPower_monitor.monitor p_RecallUrl proxy
+
+let properties proxy =
+  OBus_property.group ~monitor:UPower_monitor.monitor proxy interface
diff --git a/bindings/upower/uPower_device.mli b/bindings/upower/uPower_device.mli
new file mode 100644
index 0000000..ccfbead
--- /dev/null
+++ b/bindings/upower/uPower_device.mli
@@ -0,0 +1,90 @@
+(*
+ * uPower_device.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UPower device interface *)
+
+include OBus_proxy.Private
+
+(** {6 Types} *)
+
+(** Type of power source *)
+type typ =
+    [ `Unknown
+    | `Line_power
+    | `Battery
+    | `Ups
+    | `Monitor
+    | `Mouse
+    | `Keyboard
+    | `Pda
+    | `Phone ]
+
+(** The battery power state *)
+type state =
+    [ `Unknown
+    | `Charging
+    | `Discharging
+    | `Empty
+    | `Fully_charged
+    | `Pending_charge
+    | `Pending_discharge ]
+
+(** Technology used in the battery *)
+type technology =
+    [ `Unknown
+    | `Lithium_ion
+    | `Lithium_polymer
+    | `Lithium_iron_phosphate
+    | `Lead_acid
+    | `Nickel_cadmium
+    | `Nickel_metal_hydride ]
+
+val general_error : OBus_error.name
+
+(** {6 Methods} *)
+
+val get_statistics : t -> typ : string -> (float * float) list Lwt.t
+val get_history : t -> typ : string -> timespan : int -> resolution : int -> (int * float * int) list Lwt.t
+val refresh : t -> unit Lwt.t
+
+(** {6 Signals} *)
+
+val changed : t -> unit OBus_signal.t
+
+(** {6 Properties} *)
+
+val recall_url : t -> string OBus_property.r
+val recall_vendor : t -> string OBus_property.r
+val recall_notice : t -> bool OBus_property.r
+val technology : t -> technology OBus_property.r
+val capacity : t -> float OBus_property.r
+val is_rechargeable : t -> bool OBus_property.r
+val state : t -> state OBus_property.r
+val is_present : t -> bool OBus_property.r
+val percentage : t -> float OBus_property.r
+val time_to_full : t -> int64 OBus_property.r
+val time_to_empty : t -> int64 OBus_property.r
+val voltage : t -> float OBus_property.r
+val energy_rate : t -> float OBus_property.r
+val energy_full_design : t -> float OBus_property.r
+val energy_full : t -> float OBus_property.r
+val energy_empty : t -> float OBus_property.r
+val energy : t -> float OBus_property.r
+val online : t -> bool OBus_property.r
+val has_statistics : t -> bool OBus_property.r
+val has_history : t -> bool OBus_property.r
+val power_supply : t -> bool OBus_property.r
+val typ : t -> typ OBus_property.r
+val update_time : t -> int64 OBus_property.r
+val serial : t -> string OBus_property.r
+val model : t -> string OBus_property.r
+val vendor : t -> string OBus_property.r
+val native_path : t -> string OBus_property.r
+
+val properties : t -> OBus_property.group
diff --git a/bindings/upower/uPower_interfaces.obus b/bindings/upower/uPower_interfaces.obus
new file mode 100644
index 0000000..224ade9
--- /dev/null
+++ b/bindings/upower/uPower_interfaces.obus
@@ -0,0 +1,90 @@
+(*
+ * uPower_interfaces.obus
+ * ----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.UPower {
+  method EnumerateDevices : () -> (devices : object_path array)
+
+(* Introspections files are wrong for this signals:
+
+   signal DeviceAdded : (device : object_path)
+   signal DeviceRemoved : (device : object_path)
+   signal DeviceChanged : (device : object_path) *)
+
+  signal DeviceAdded : (device : string)
+  signal DeviceRemoved : (device : string)
+  signal DeviceChanged : (device : string)
+
+  signal Changed : ()
+  signal Sleeping : ()
+  signal Resuming : ()
+  method AboutToSleep : () -> ()
+  method Suspend : () -> ()
+  method SuspendAllowed : () -> (allowed : boolean)
+  method Hibernate : () -> ()
+  method HibernateAllowed : () -> (allowed : boolean)
+  property_r DaemonVersion : string
+  property_r CanSuspend : boolean
+  property_r CanHibernate : boolean
+  property_r OnBattery : boolean
+  property_r OnLowBattery : boolean
+  property_r LidIsClosed : boolean
+  property_r LidIsPresent : boolean
+}
+
+interface org.freedesktop.UPower.Device {
+  method Refresh : () -> ()
+  signal Changed : ()
+  method GetHistory : (type : string, timespan : uint32, resolution : uint32) -> (data : (uint32 * double * uint32) array)
+  method GetStatistics : (type : string) -> (data : (double * double) array)
+  property_r NativePath : string
+  property_r Vendor : string
+  property_r Model : string
+  property_r Serial : string
+  property_r UpdateTime : uint64
+  property_r Type : uint32
+  property_r PowerSupply : boolean
+  property_r HasHistory : boolean
+  property_r HasStatistics : boolean
+  property_r Online : boolean
+  property_r Energy : double
+  property_r EnergyEmpty : double
+  property_r EnergyFull : double
+  property_r EnergyFullDesign : double
+  property_r EnergyRate : double
+  property_r Voltage : double
+  property_r TimeToEmpty : int64
+  property_r TimeToFull : int64
+  property_r Percentage : double
+  property_r IsPresent : boolean
+  property_r State : uint32
+  property_r IsRechargeable : boolean
+  property_r Capacity : double
+  property_r Technology : uint32
+  property_r RecallNotice : boolean
+  property_r RecallVendor : string
+  property_r RecallUrl : string
+}
+
+interface org.freedesktop.UPower.QoS {
+  method SetMinimumLatency : (type : string, value : int32) -> ()
+  method RequestLatency : (type : string, value : int32, persistent : boolean) -> (cookie : uint32)
+  method CancelRequest : (type : string, cookie : uint32) -> ()
+  method GetLatency : (type : string) -> (value : int32)
+  signal LatencyChanged : (type : string, value : int32)
+  method GetLatencyRequests : () -> (requests : (uint32 * uint32 * uint32 * string * int64 * boolean * string * string * int32) array)
+  signal RequestsChanged : ()
+}
+
+interface org.freedesktop.UPower.Wakeups {
+  property_r HasCapability : boolean
+  method GetTotal : () -> (value : uint32)
+  signal TotalChanged : (value : uint32)
+  method GetData : () -> (data : (boolean * uint32 * double * string * string) array)
+  signal DataChanged : ()
+}
diff --git a/bindings/upower/uPower_monitor.ml b/bindings/upower/uPower_monitor.ml
new file mode 100644
index 0000000..3a36071
--- /dev/null
+++ b/bindings/upower/uPower_monitor.ml
@@ -0,0 +1,35 @@
+(*
+ * uPower_monitor.ml
+ * -----------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt_react
+open Lwt
+
+module String_map = Map.Make(String)
+
+let changed interface =
+  OBus_member.Signal.make
+    ~interface
+    ~member:"Changed"
+    ~args:OBus_value.arg0
+    ~annotations:[]
+
+let monitor proxy interface switch =
+  let%lwt event =
+    OBus_signal.connect ~switch
+      (OBus_signal.with_context
+         (OBus_signal.make (changed interface) proxy))
+  and context, dict = OBus_property.get_all_no_cache proxy interface in
+  return (S.hold
+            ~eq:(String_map.equal (=))
+            (OBus_property.map_of_list context dict)
+            (E.map_s
+               (fun (context, ()) ->
+                  let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in
+                  return (OBus_property.map_of_list context dict))
+               event))
diff --git a/bindings/upower/uPower_monitor.mli b/bindings/upower/uPower_monitor.mli
new file mode 100644
index 0000000..a8a7376
--- /dev/null
+++ b/bindings/upower/uPower_monitor.mli
@@ -0,0 +1,13 @@
+(*
+ * uPower_monitor.mli
+ * ------------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Properties monitoring *)
+
+val monitor : OBus_property.monitor
+  (** Monitor for properties of upower interfaces. *)
diff --git a/bindings/upower/uPower_policy.ml b/bindings/upower/uPower_policy.ml
new file mode 100644
index 0000000..2f376db
--- /dev/null
+++ b/bindings/upower/uPower_policy.ml
@@ -0,0 +1,83 @@
+(*
+ * uPower_policy.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+type cookie = int
+
+type latency = [ `Cpu_dma | `Network ]
+
+let string_of_latency = function
+  | `Cpu_dma -> "cpu_dma"
+  | `Network -> "network"
+
+let latency_of_string = function
+  | "cpu_dma" -> `Cpu_dma
+  | "network" -> `Network
+  | latency -> Printf.ksprintf failwith "unknown latency type (%S)" latency
+
+type latency_request = {
+  lr_cookie : cookie;
+  lr_uid : int;
+  lr_pid : int;
+  lr_exec : string;
+  lr_timespec : int64;
+  lr_persistent : bool;
+  lr_typ : latency;
+  lr_reserved : string;
+  lr_value : int;
+}
+
+open UPower_interfaces.Org_freedesktop_UPower_QoS
+
+let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Policy"]
+
+let set_minimum_latency daemon ~latency ~value =
+  OBus_method.call m_SetMinimumLatency (proxy daemon) (string_of_latency latency, Int32.of_int value)
+
+let request_latency daemon ~latency ~value ~persistent =
+  let value = Int32.of_int value in
+  let%lwt cookie = OBus_method.call m_RequestLatency (proxy daemon) (string_of_latency latency, value, persistent) in
+  let cookie = Int32.to_int cookie in
+  return cookie
+
+let cancel_request daemon ~latency ~cookie =
+  let cookie = Int32.of_int cookie in
+  OBus_method.call m_CancelRequest (proxy daemon) (string_of_latency latency, cookie)
+
+let get_latency daemon ~latency =
+  let%lwt value = OBus_method.call m_GetLatency (proxy daemon) (string_of_latency latency) in
+  let value = Int32.to_int value in
+  return value
+
+let latency_changed daemon =
+  OBus_signal.map
+    (fun (latency, value) ->
+       (latency_of_string latency, Int32.to_int value))
+    (OBus_signal.make s_LatencyChanged (proxy daemon))
+
+let get_latency_requests daemon =
+  let%lwt requests = OBus_method.call m_GetLatencyRequests (proxy daemon) () in
+  return
+    (List.map
+       (fun (cookie, uid, pid, exec, timespec, persistent, typ, reserved, value) -> {
+          lr_cookie = Int32.to_int cookie;
+          lr_uid = Int32.to_int uid;
+          lr_pid = Int32.to_int pid;
+          lr_exec = exec;
+          lr_timespec = timespec;
+          lr_persistent = persistent;
+          lr_typ = latency_of_string typ;
+          lr_reserved = reserved;
+          lr_value = Int32.to_int value;
+        })
+       requests)
+
+let requests_changed daemon =
+  OBus_signal.make s_RequestsChanged (proxy daemon)
diff --git a/bindings/upower/uPower_policy.mli b/bindings/upower/uPower_policy.mli
new file mode 100644
index 0000000..a993c00
--- /dev/null
+++ b/bindings/upower/uPower_policy.mli
@@ -0,0 +1,61 @@
+(*
+ * uPower_policy.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Quality of service policy *)
+
+(** {6 Types} *)
+
+type cookie
+  (** Type of request identifiers *)
+
+type latency = [ `Cpu_dma | `Network ]
+  (** Type of latency request *)
+
+type latency_request = {
+  lr_cookie : cookie;
+  (** The random cookie that identifies the request. *)
+
+  lr_uid : int;
+  (** The user ID that issued the request. *)
+
+  lr_pid : int;
+  (** The process ID of the application. *)
+
+  lr_exec : string;
+  (** The executable that issued the request. *)
+
+  lr_timespec : int64;
+  (** The number of seconds since the epoch. *)
+
+  lr_persistent : bool;
+  (** If the request is persistent and outlives the connection lifetime. *)
+
+  lr_typ : latency;
+  (** The type of the request.*)
+
+  lr_reserved : string;
+
+  lr_value : int;
+  (** The value, in microseconds or kilobits per second. *)
+}
+
+(** {6 Methods} *)
+
+val get_latency_requests : UPower.t -> latency_request list Lwt.t
+val get_latency : UPower.t -> latency : latency -> int Lwt.t
+
+val request_latency : UPower.t -> latency : latency -> value : int -> persistent : bool -> cookie Lwt.t
+val cancel_request : UPower.t -> latency : latency -> cookie : cookie -> unit Lwt.t
+
+val set_minimum_latency : UPower.t -> latency : latency -> value : int -> unit Lwt.t
+
+(** {6 Signals} *)
+
+val requests_changed : UPower.t -> unit OBus_signal.t
+val latency_changed : UPower.t -> (latency * int) OBus_signal.t
diff --git a/bindings/upower/uPower_wakeups.ml b/bindings/upower/uPower_wakeups.ml
new file mode 100644
index 0000000..eeeb2ca
--- /dev/null
+++ b/bindings/upower/uPower_wakeups.ml
@@ -0,0 +1,53 @@
+(*
+ * uPower_wakeups.ml
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+type data = {
+  data_is_userspace : bool;
+  data_id : int;
+  data_value : float;
+  data_cmdline : string option;
+  data_details : string;
+}
+
+open UPower_interfaces.Org_freedesktop_UPower_Wakeups
+
+let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Wakeups"]
+
+let has_capability daemon =
+  OBus_property.make p_HasCapability (proxy daemon)
+
+let get_total daemon =
+  let%lwt value = OBus_method.call m_GetTotal (proxy daemon) () in
+  let value = Int32.to_int value in
+  return value
+
+let total_changed daemon =
+  OBus_signal.map
+    (fun value ->
+       let value = Int32.to_int value in
+       value)
+    (OBus_signal.make s_TotalChanged (proxy daemon))
+
+let get_data daemon =
+  let%lwt data = OBus_method.call m_GetData (proxy daemon) () in
+  return
+    (List.map
+       (fun (is_userspace, id, value, cmdline, details) -> {
+          data_is_userspace = is_userspace;
+          data_id = Int32.to_int id;
+          data_value = value;
+          data_cmdline = if cmdline = "" then None else Some cmdline;
+          data_details = details;
+        })
+       data)
+
+let data_changed daemon =
+  OBus_signal.make s_DataChanged (proxy daemon)
diff --git a/bindings/upower/uPower_wakeups.mli b/bindings/upower/uPower_wakeups.mli
new file mode 100644
index 0000000..16db989
--- /dev/null
+++ b/bindings/upower/uPower_wakeups.mli
@@ -0,0 +1,47 @@
+(*
+ * uPower_wakeups.mli
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** UPower wakeups interface *)
+
+(** {6 Types} *)
+
+(** The data of all the processes and drivers which contribute to the
+    wakeups on the system. *)
+type data = {
+  data_is_userspace : bool;
+  (** If the wakeup is from userspace ? *)
+
+  data_id : int;
+  (** The process ID of the application, or the IRQ for kernel
+      drivers. *)
+
+  data_value : float;
+  (** The number of wakeups per second. *)
+
+  data_cmdline : string option;
+  (** The command line for the application, or [None] for kernel
+      drivers. *)
+
+  data_details : string;
+  (** The details about the wakeup. *)
+}
+
+(** {6 Methods} *)
+
+val get_data : UPower.t -> data list Lwt.t
+val get_total : UPower.t -> int Lwt.t
+
+(** {6 Signals} *)
+
+val data_changed : UPower.t -> unit OBus_signal.t
+val total_changed : UPower.t -> int OBus_signal.t
+
+(** {6 Properties} *)
+
+val has_capability : UPower.t -> bool OBus_property.r
diff --git a/docs/apiref-intro b/docs/apiref-intro
new file mode 100644
index 0000000..9bde14d
--- /dev/null
+++ b/docs/apiref-intro
@@ -0,0 +1,133 @@
+{1 OBus - API Reference}
+
+{2 OBus library}
+
+This section describe modules of the core OBus library. OBus is
+composed of a lot of modules, but you will usually need only a few of
+them.
+
+{3 Connections and message Buses}
+
+{!modules:
+OBus_bus
+OBus_connection
+OBus_server
+}
+
+{3 D-Bus objects}
+
+{!modules:
+OBus_proxy
+OBus_object
+OBus_method
+OBus_signal
+OBus_property
+OBus_member
+}
+
+{3 Introspection}
+
+{!modules:
+OBus_introspect
+OBus_introspect_ext
+}
+
+{3 Misc}
+
+{!modules:
+OBus_error
+OBus_value
+OBus_resolver
+OBus_peer
+OBus_info
+OBus_name
+OBus_path
+OBus_string
+OBus_uuid
+OBus_context
+}
+
+{3 OBus low-level API}
+
+{!modules:
+OBus_match
+OBus_message
+OBus_address
+OBus_auth
+OBus_transport
+OBus_wire
+}
+
+{2 Service bindings}
+
+This section list bindings to D-Bus services shipped with OBus.
+
+{3 Notifications}
+
+Bindings to the freedesktop popup notification service.
+
+{!modules:
+Notification
+}
+
+{3 PolicyKit}
+
+Bindings to the freedesktop popup PolicyKit service.
+
+{!modules:
+Policy_kit
+}
+
+{3 Hal}
+
+Bindings to the freedesktop Hal service.
+
+{!modules:
+Hal_manager
+Hal_device
+}
+
+{3 UPower}
+
+Bindings to the freedesktop UPower service.
+
+{!modules:
+UPower
+UPower_device
+UPower_policy
+UPower_wakeups
+}
+
+{3 UPower}
+
+Bindings to the freedesktop UDisks service.
+
+{!modules:
+UDisks
+UDisks_device
+UDisks_port
+UDisks_adapter
+UDisks_expander
+}
+
+{3 NetworkManager}
+
+Bindings to the NetworkManager service.
+
+{!modules:
+Nm_access_point
+Nm_connection
+Nm_device
+Nm_dhcp4_config
+Nm_ip4_config
+Nm_ip6_config
+Nm_manager
+Nm_ppp
+Nm_settings
+Nm_vpn_connection
+Nm_vpn_plugin
+}
+
+{3 Index}
+
+{!indexlist}
diff --git a/docs/man/dune b/docs/man/dune
new file mode 100644
index 0000000..b2bca8c
--- /dev/null
+++ b/docs/man/dune
@@ -0,0 +1,10 @@
+(install
+  (section man)
+  (files
+    obus-dump.1
+    obus-gen-client.1
+    obus-gen-interface.1
+    obus-gen-server.1
+    obus-idl2xml.1
+    obus-introspect.1
+    obus-xml2idl.1))
\ No newline at end of file
diff --git a/docs/man/obus-dump.1 b/docs/man/obus-dump.1
new file mode 100644
index 0000000..cb7b5d4
--- /dev/null
+++ b/docs/man/obus-dump.1
@@ -0,0 +1,44 @@
+\" obus-dump.1
+\" -----------
+\" Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+\" This file is a part of obus, an ocaml implementation of D-Bus.
+
+.TH OBUS-DUMP 1 "October 2009"
+
+.SH NAME
+obus-dump \- a D-Bus message dumper
+
+.SH SYNOPSIS
+.B obus-dump
+[
+.I options
+]
+.I command
+[
+.I arguments
+]
+
+.SH DESCRIPTION
+
+.B obus-dump
+allows you to run a command and dumps all messages it tries to send
+through the session or system bus.
+
+.SH OPTIONS
+
+.IP "-o output-file"
+Uses
+.I output-file
+as output file instead of stderr.
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-introspect (1),
+.BR obus-binder (1).
diff --git a/docs/man/obus-gen-client.1 b/docs/man/obus-gen-client.1
new file mode 100644
index 0000000..fee5a80
--- /dev/null
+++ b/docs/man/obus-gen-client.1
@@ -0,0 +1,53 @@
+\" obus-gen-client.1
+\" -----------------
+\" Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+
+.TH OBUS-GEN-CLIENT 1 "April 2010"
+
+.SH NAME
+obus-gen-client \- generate client-side ocaml bindings from D-Bus introspection files
+
+.SH SYNOPSIS
+.B obus-gen-client
+[
+.I options
+]
+.I input-file
+
+.SH DESCRIPTION
+
+.B obus-gen-client
+generates an ocaml module from D-Bus introspection files. The
+generated module contains functions to send method calls, receive
+signals and read/write properties. It depends on the interface module
+generated with
+.B obus-gen-interface.
+
+The module generated by
+.B obus-gen-client
+it is meant to be edited.
+
+.SH OPTIONS
+
+.IP "-o output-prefix"
+Use this name as output prefix. It defaults to the input file name
+without its extension and extended with "_client". For example, if the
+input file name is "foo.xml" (or "foo.obus"), then "obus-gen-client"
+will generate "foo_client.ml" and "foo_client.mli".
+
+.IP "-keep-common"
+Keeps common interfaces, i.e. all interfaces starting with
+"org.freedesktop.DBus". By default they are dropped.
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-introspect (1),
+.BR obus-gen-interface (1),
+.BR obus-gen-server (1).
diff --git a/docs/man/obus-gen-interface.1 b/docs/man/obus-gen-interface.1
new file mode 100644
index 0000000..1ca272d
--- /dev/null
+++ b/docs/man/obus-gen-interface.1
@@ -0,0 +1,60 @@
+\" obus-gen-interface.1
+\" --------------------
+\" Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+\" This file is a part of obus, an ocaml implementation of D-Bus.
+
+.TH OBUS-GEN-INTERFACE 1 "April 2010"
+
+.SH NAME
+obus-gen-interface \- convert D-Bus introspection files to ocaml code
+
+.SH SYNOPSIS
+.B obus-gen-interface
+[
+.I options
+]
+.I input-file
+
+.SH DESCRIPTION
+
+.B obus-gen-interface
+generates an OCaml module from a D-Bus introspection file. The
+generated module contains methods, signals and properties
+definitions. It is required for by both client-side and server-side
+code.
+
+Note that the files generated by
+.B obus-gen-interface
+are not meant to be edited.
+
+.SH OPTIONS
+
+.IP "-o output-prefix"
+Use this name as output prefix. It defaults to the input file name
+without its extension and extended with "_interfaces". For example, if
+the input file name is "foo.xml" (or "foo.obus"), then
+"obus-gen-interface" will generate "foo_interfaces.ml" and
+"foo_interfaces.mli".
+
+.IP "-keep-common"
+Keeps common interfaces, i.e. all interfaces starting with
+"org.freedesktop.DBus". By default they are dropped.
+
+.IP "-mode {both|client|server}"
+Set the code generation mode. It defaults to "both". In "client" mode,
+only code for client-side use is generated. In "server" mode, only
+code for server-side use is generated. In "both" mode, code for
+client-side and server-side use is generated.
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-introspect (1),
+.BR obus-gen-client (1),
+.BR obus-gen-server (1).
diff --git a/docs/man/obus-gen-server.1 b/docs/man/obus-gen-server.1
new file mode 100644
index 0000000..9991be9
--- /dev/null
+++ b/docs/man/obus-gen-server.1
@@ -0,0 +1,53 @@
+\" obus-gen-server.1
+\" -----------------
+\" Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+
+.TH OBUS-GEN-SERVER 1 "April 2010"
+
+.SH NAME
+obus-gen-server \- generate server-side ocaml bindings from D-Bus introspection files
+
+.SH SYNOPSIS
+.B obus-gen-server
+[
+.I options
+]
+.I input-files
+
+.SH DESCRIPTION
+
+.B obus-gen-server
+generates an ocaml module from D-Bus introspection files. The
+generated module contains code for defining a D-Bus service
+implementing the D-Bus interfaces listed in intropection files. It
+depends on the interface module generated with
+.B obus-gen-interface.
+
+The module generated by
+.B obus-gen-server
+it is meant to be edited.
+
+.SH OPTIONS
+
+.IP "-o output-prefix"
+Use this name as output prefix. It defaults to the input file name
+without its extension and extended with "_server". For example, if the
+input file name is "foo.xml" (or "foo.obus"), then "obus-gen-server"
+will generate "foo_server.ml" and "foo_server.mli".
+
+.IP "-keep-common"
+Keeps common interfaces, i.e. all interfaces starting with
+"org.freedesktop.DBus". By default they are dropped.
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-introspect (1),
+.BR obus-gen-interface (1),
+.BR obus-gen-client (1).
diff --git a/docs/man/obus-idl2xml.1 b/docs/man/obus-idl2xml.1
new file mode 100644
index 0000000..7d910b7
--- /dev/null
+++ b/docs/man/obus-idl2xml.1
@@ -0,0 +1,37 @@
+\" obus-idl2xml.1
+\" --------------
+\" Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+
+.TH OBUS-IDL2XML 1 "April 2010"
+
+.SH NAME
+obus-idl2xml \- convert an obus IDL file into a  D-Bus introspection one
+
+.SH SYNOPSIS
+.B obus-idl2xml
+[
+.I options
+]
+.I input-file
+
+.SH DESCRIPTION
+
+.B obus-xml2idl
+generates a D-Bus xml introspection file from an obus IDL one
+
+.SH OPTIONS
+
+.IP "-o file-name"
+Use this name as output. It defaults to the input file name with the
+extension replaced by "xml".
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-xml2idl.
diff --git a/docs/man/obus-introspect.1 b/docs/man/obus-introspect.1
new file mode 100644
index 0000000..814214f
--- /dev/null
+++ b/docs/man/obus-introspect.1
@@ -0,0 +1,54 @@
+\" obus-introspect.1
+\" -----------------
+\" Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+\" This file is a part of obus, an ocaml implementation of D-Bus.
+
+.TH OBUS-INTROSPECT 1 "October 2009"
+
+.SH NAME
+obus-introspect \- a D-Bus introspecter
+
+.SH SYNOPSIS
+.B obus-intrpsoect
+[
+.I options
+]
+.I destination
+.I path
+
+.SH DESCRIPTION
+
+.B obus-introspect
+allow you to introspect a D-Bus service. Given a
+.B path
+it can introspect recursively all its children. By default it prints
+only all the interfaces it found, but it can also prints all object
+path with the interfaces they implements.
+
+.SH OPTIONS
+
+.IP -rec
+Introspects recursively all sub-nodes instead of just the one of
+.B path
+.I path
+
+.IP -session
+The service is on the session bus (the default).
+
+.IP -system
+The service is on the system bus.
+
+.IP -objects
+List objects with interfaces they implements instead of interfaces.
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-dump (1),
+.BR obus-binder (1).
diff --git a/docs/man/obus-xml2idl.1 b/docs/man/obus-xml2idl.1
new file mode 100644
index 0000000..eadd064
--- /dev/null
+++ b/docs/man/obus-xml2idl.1
@@ -0,0 +1,47 @@
+\" obus-xml2idl.1
+\" --------------
+\" Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+\" Licence   : BSD3
+\"
+
+.TH OBUS-XML2IDL 1 "April 2010"
+
+.SH NAME
+obus-xml2idl \- convert a D-Bus introspection file into an obus IDL one
+
+.SH SYNOPSIS
+.B obus-xml2idl
+[
+.I options
+]
+.I input-file
+
+.SH DESCRIPTION
+
+.B obus-xml2idl
+generates an obus IDL file from a D-Bus xml introspection file. THe
+file can then be used with other obus tools such as
+.B obus-gen-interface
+,
+.B obus-gen-client
+,
+.B obus-gen-server
+.
+
+The goal of the obus IDL is to allow you to write D-Bus interface with
+a syntax lighter than XML.
+
+.SH OPTIONS
+
+.IP "-o file-name"
+Use this name as output. It defaults to the input file name with the
+extension replaced by "obus".
+
+.IP "-help or --help"
+Display a short usage summary and exit.
+
+.SH AUTHOR
+Jérémie Dimino <jeremie@dimino.org>
+
+.SH "SEE ALSO"
+.BR obus-idl2xml.
diff --git a/docs/manual/Makefile b/docs/manual/Makefile
new file mode 100644
index 0000000..2583c69
--- /dev/null
+++ b/docs/manual/Makefile
@@ -0,0 +1,19 @@
+# Makefile
+# --------
+# Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+# Licence   : BSD3
+#
+# This file is a part of obus, an ocaml implementation of D-Bus.
+
+.PHONY: all clean clean-aux
+
+all: manual.pdf
+
+%.pdf: %.tex
+	rubber --pdf $<
+
+clean: clean-aux
+	rm -f *.pdf
+
+clean-aux:
+	rm -f *.aux *.dvi *.log *.out *.toc *.html *.htoc *.haux
diff --git a/docs/manual/manual.rst b/docs/manual/manual.rst
new file mode 100644
index 0000000..03414c5
--- /dev/null
+++ b/docs/manual/manual.rst
@@ -0,0 +1,662 @@
+********
+Overview
+********
+
+**D-Bus** is an inter-processes communication protocol, or IPC for
+short, which has recently become a standard on desktop oriented
+computers. It is now possible to talk to a lot application using
+dbus. Moreover, it has many bindings/implementations for differents
+languages, which make it easily accessible. **OBus** is a pure OCaml
+implementation of this protocol. What makes it different from other
+bindings/implementations is that it is the only one using
+cooperative threads, which makes it very simple to fully exploit the
+asynchronous nature of dbus.
+
+The main package of the OBus distribution is the ``obus`` findlib
+package, which contains the core library and some utilities for
+generating OCaml client modules from arbitrary dbus services.
+OBus also comes with some packages containing high level bindings to
+a few well-known Freedesktop dbus services:
+
+- ``obus.hal``
+- ``obus.notification``
+- ``obus.network-manager``
+- ``obus.policykit``
+- ``obus.udisks``
+- ``obus.upower``
+
+The low-level API is described in the section `Low-level use of OBus`_
+of this manual. Note that you must have a good knowledge of dbus to
+use it effectively.
+
+It is recommended to familiarize yourself with the Lwt_ library before
+using OBus.
+
+.. _Lwt: https://ocsigen.org/lwt/
+
+------------------------------------------
+
+***********
+Quick start
+***********
+
+This section provides simple usage examples of OBus and the utilities
+it comes with. You can also look at the examples_ directory for more
+concrete examples.
+
+.. _examples: https://github.com/diml/obus/tree/master/docs/examples
+
+
+Using the predefined bindings
+-----------------------------
+
+The usage of the predefined bindings is straightforward and doesn't
+require any knowledge of dbus nor OBus. This is a program that opens
+a popup notification::
+
+  let () = Lwt_main.run begin
+    let%lwt id = Notification.notify ~summary:"Hello, world!" () in
+    Lwt.return ()
+  end
+
+
+Generating a client OCaml module from a running service
+-------------------------------------------------------
+
+To use a dbus service, you first have to obtain its interface through
+its published introspection XML. Some applications put these files into
+``/usr/share/dbus-1/interfaces/``, but you can also just directly ask a
+running service::
+
+  $ obus-introspect -rec org.foo.bar / > foo.xml
+
+This will recursively introspect the ``org.foo.bar`` service, and dump
+its interface data into ``foo.xml``
+
+The next step is to generate an OCaml module describing its interface::
+
+  $ obus-gen-interface foo.xml
+
+This will generate ``foo_interfaces.ml`` and ``foo_interfaces.mli``.
+The generated interfaces shouldn't be directly edited.
+
+Now we can generate the client module::
+
+  $ obus-gen-client foo.xml
+
+This will generate ``foo_client.ml`` and ``foo_client.mli``.
+These generated clients can be freely edited, and have to be compiled
+with the ``lwt_ppx`` syntax extension.
+
+Now we can use the ``Foo_client`` module to interact with the service.
+Methods are mapped to functions returning ``Lwt.t`` wrapped values,
+signals are mapped to values of type ``OBus_signal.t``, and properties
+to values of type ``OBus_property.t``. For example::
+
+  let () = Lwt_main.run begin
+    (* Connect to the session bus *)
+    let%lwt bus = OBus_bus.session () in
+
+    (* Create a proxy for a remote object *)
+    let proxy =
+      OBus_proxy.make
+        (OBus_peer.make bus "org.foo.bar")
+        ["org"; "foo"; "bar"]
+    in
+
+    (* Call a method *)
+    let%lwt result = Foo_client.Org_foo_bar.plop proxy ... in
+
+    (* Connect to a signal *)
+    let%lwt () =
+      Lwt_react.E.notify (fun args -> ...)
+      =|< OBus_signal.connect (Foo_client.Org_foo_bar.plip proxy)
+    in
+
+    (* Read the contents of a property *)
+    let%lwt value = OBus_property.get (Foo_client.Org_foo_bar.plap proxy) in
+
+    ...
+  end
+
+
+-----------------------------------------------
+
+******
+Basics
+******
+
+In this section we will describe the minimum you must know to use
+OBus and interfaces for dbus services written with OBus (like the
+ones provided in the OBus distribution: ``obus.notification``,
+``obus.upower``, ...)
+
+
+Connections and message buses
+-----------------------------
+
+A ``connection`` is a way of exchanging messages with another
+application speaking the dbus protocol. Most of the time applications
+use connection to a special application called a *message bus*.
+A message bus act as a router between several applications. On a desktop
+computer, there are two well-known instances: the *system* message bus,
+and the user *session* message bus.
+
+The first one is unique given a computer, and uses security
+policies. The second is unique given a user session. Its goal is to
+allow programs running in the same session to talk to each other.
+OBus offers two function for connecting to these message buses:
+``OBus_bus.session`` and ``OBus_bus.system``.
+
+The session bus exists for the life-time of a user session. It exits
+when the session is closed, and any programs using it should exit to,
+that is why OBus will exit the program when the connection to the
+session bus is lost. However this behavior can be changed.
+
+On the other hand, the system bus can be restarted and programs using it
+may try to reopen the connection. System-wide application should
+handle the loss of the connection with the system bus.
+
+Here is a small example which connects the session bus and prints its id::
+
+  let () = Lwt_main.run begin
+    (* Open a connection to the session message bus: *)
+    let%lwt bus = OBus_bus.session () in
+
+    (* Obtain its id: *)
+    let%lwt id = OBus_bus.get_id bus in
+
+    Lwt_io.printlf "The session bus id is %d." (OBus_uuid.to_string id)
+  end
+
+
+Names
+-----
+
+On a message bus, applications are referenced using names. There is a
+special category of names called *unique names*. Each time an
+application connects to a bus, the bus give it a unique name. Unique
+name are of the form ``:1.42`` and cannot be changed. You can
+think of a unique name as an *ip* (such as ``192.168.1.42``).
+
+Once connected, the unique name can be retrieved with the function
+``OBus_bus.name``. Here is a program that prints its own unique name::
+
+  let () = Lwt_main.run begin
+    (* Connects to the session bus: *)
+    let%lwt bus = OBus_bus.session () in
+
+    (* Read our unique name: *)
+    let%lwt name = OBus_bus.name bus in
+
+    Lwt_io.printlf "My unique connection name is %s." name
+  end
+
+Unique names are useful to uniquely identify an application. However,
+when you want to use a specific service you may prefer using a
+well-known name such as ``org.freedesktop.Notifications``. D-Bus
+allows applications to own as many non-unique names as they want. You
+can think of a non-unique name as an *url* (such as
+``obus.forge.ocamlcore.org``).
+
+Names can be requested or resolved using functions of the ``OBus_bus`` module.
+Here is an example::
+
+  let () = Lwt_main.run begin
+    let%lwt bus = OBus_bus.session () in
+
+    let%lwt () =
+      try%lwt
+        (* Try to resolve a name, this may fail if nobody owns it: *)
+        let%lwt owner =
+          OBus_bus.get_name_owner bus "org.freedesktop.Notifications"
+        in
+        Lwt_io.printlf "The owner is %d."
+      with OBus_bus.Name_has_no_owner msg ->
+        Lwt_io.printlf "Cannot resolve the name: %s." msg
+    in
+
+    (* Request a name: *)
+    OBus_bus.request_name bus "org.foo.bar" >>= function
+      | `Primary_owner ->
+          Lwt_io.printl "I own the name org.foo.bar!"
+      | `In_queue ->
+          Lwt_io.printl "Somebody else owns the name, i am in the queue."
+      | `Exists ->
+          Lwt_io.printl "Somebody else owns the name\
+                         and does not want to lose it :(."
+      | `Already_owner
+          (* Cannot happen *)
+          Lwt_io.printl "I already owns this name."
+  end
+
+Note that the ``OBus_resolver`` module offer a better way of resolving
+names and monitoring name owners. See section `Name Tracking`_ for details.
+
+
+Peers
+-----
+
+A *peer* represents an application accessible through a dbus connection.
+To uniquely identify a peer one needs a connection and a name.
+The module ``OBus_peer`` defines the type type of peers.
+There are two requests that should be available on all peers:
+``ping`` and ``get_machine_id``. The first one just pings the peer to see
+if it is alive, and the second returns the id of the machine the peer
+is currently running on.
+
+
+Objects and proxies
+-------------------
+
+In order to export services, dbus uses the concept of *objects*.
+An application may holds as many objects as it wants.
+From the inside of the application, dbus objects are generally mapped to
+language-native objects. From the outside, objects are refered to though
+*object-paths*, which looks like ``/org/freedesktop/DBus``.
+You can think of an object path as a pointer.
+
+Objects may have members which are organized by interface (such as
+``org.freedesktop.DBus``. There are three types of members:
+
+- Methods
+- Signals
+- Properties
+
+Methods act like functions which can be called by any client.
+
+Signals are spontaneous events that may occurs at any time, which clients
+may register to in order to be notified when they occur.
+
+Properties act as variables, which can be read and/or written, and
+sometimes monitored.
+
+In order to uniquely identify an object, we need its path and the peer
+that owns it. We call such a thing a *proxy*. Proxies are defined
+in the module ``OBus_proxy``
+
+Here is a simple example of how to call a method on a proxy (we will
+explain the ``C.seq...`` things later)::
+
+  open OBus_value
+
+  let () = Lwt_main.run begin
+    let%lwt bus = OBus_bus.session () in
+
+    (* Create the peer: *)
+    let%lwt peer = OBus_peer.make ~name:"org.freedesktop.DBus" ~connection:bus in
+
+    (* Create the proxy: *)
+    let%lwt proxy = OBus_proxy.make ~peer ~path:["org"; "freedesktop"; "DBus"] in
+
+    (* Call a method: *)
+    let%lwt id =
+      OBus_proxy.call proxy
+        ~interface:"org.freedesktop.DBus"
+        ~member:"GetId"
+        ~i_args:C.seq0
+        ~o_args:(C.seq1 C.basic_string)
+        ()
+    in
+
+    Lwt_io.printlf "The bus id is: %s" id
+  end
+
+
+--------------------------------------------------
+
+*******************************************************
+Interaction between the OCaml world and the D-Bus world
+*******************************************************
+
+Value mapping
+-------------
+
+D-Bus defines its own type system, which is used to serialize and
+deserialize messages.  These types are defined in the module
+``OBus_value.T``, and dbus values are defined in the module
+``OBus_value.V``.  When a message is received, its contents are
+represented as a value of type ``OBus_value.V.sequence``.
+Similarly, when a message is sent, it is first converted into this
+format.
+
+Manipulating boxed dbus values is not very handy. To make the
+interaction more transparent, OBus defines a set of type combinators
+which allow to easily switch between the dbus representation and the
+OCaml representation. These converters are defined in the module
+``OBus_value.C``. Here is an example (in the toplevel)::
+
+  # open OBus_value;;
+
+  (* Make a D-Bus value from an ocaml one: *)
+  # C.make_sequence (C.seq2 C.basic_int32 (C.array C.basic_string)) (42l, ["foo"; "bar"]);;
+  - : OBus_value.V.sequence =
+  [OBus_value.V.Basic (OBus_value.V.Int32 42l);
+   OBus_value.V.Array (OBus_value.T.Basic OBus_value.T.String,
+    [OBus_value.V.Basic (OBus_value.V.String "foo");
+     OBus_value.V.Basic (OBus_value.V.String "bar")])]
+
+  (* Cast a D-Bus value to an ocaml one: *)
+  # C.cast_sequence (C.seq1 C.basic_string) [V.basic(V.string "foobar")];;
+  - : string = "foobar"
+
+  (* Try to cast a D-Bus value to an ocaml one with the wrong type: *)
+  # C.cast_sequence (C.seq1 C.basic_string) [V.basic(V.int32 0l)];;
+  Exception: OBus_value.C.Signature_mismatch.
+
+
+Error mapping
+-------------
+
+A call to a method may fail. In this case the service sends an error
+to the caller. OCaml exceptions can be mapped to dbus errors with the
+the ``OBus_error`` module by registering them with the
+``OBus_error.Register`` functor. OBus provides a PPX syntax extension
+to simplify this process::
+
+  exception My_exn of string
+    [@@obus "org.foo.bar.MyError"]
+
+
+-----------------------------------------------------
+
+********************
+Using D-Bus services
+********************
+
+In this section we describe the canonical way of using a dbus service
+with OBus.
+
+
+Defining and using members
+--------------------------
+
+For all types of members (methods, signals and properties), dbus
+provides types to defines them and functions to use these definitions.
+A member definition contains all the information about a member.
+For example, here is the definition of a method call named ``foo``
+on interface ``org.foo.bar`` which takes a string and returns
+an 32-bits signed integer::
+
+  open OBus_member
+
+  let m_Foo = {
+    Method.interface = "org.foo.bar";
+    Method.member = "Foo";
+    Method.i_args = C.seq1 C.basic_string;
+    Method.o_args = C.seq1 C.basic_int32;
+    Method.annotations = [];
+  }
+
+Once a member is defined, it can be used by the corresponding modules::
+
+  open OBus_members
+
+  (* Definition of a method *)
+  let m_GetId = {
+    Method.interface = "org.freedesktop.DBus";
+    Method.member = "GetId";
+    Method.i_args = C.seq0;
+    Method.o_args = C.seq1 C.basic_string;
+    Method.annotations = [];
+  }
+
+  (* Definition of a signal *)
+  let s_NameAcquired = {
+    Signal.interface = "org.freedesktop.DBus";
+    Signal.member = "NameAcquired";
+    Signal.args = C.seq1 (C.basic C.string);
+    Signal.annotations = [];
+  }
+
+  let () = Lwt_main.run begin
+    let%lwt bus = OBus_bus.session () in
+    let proxy =
+      OBus_proxy.make
+        (OBus_peer.make bus "org.freedesktop.DBus")
+        ["org"; "freedesktop"; "DBus"]
+    in
+
+    (* Call the method we just defined: *)
+    let%lwt id = OBus_method.call m_GetId proxy () in
+
+    (* Register to the signal we just defined: *)
+    let%lwt event = OBus_signal.connect (OBus_signal.make s_NameAcquired proxy) in
+
+    Lwt_react.E.notify_p
+      (fun name ->
+         Lwt_io.printlf "name acquired: %s" name)
+      event;
+
+    Lwt_io.printlf "The message bus id is %s" id
+  end
+
+Of course, writing definitions by hand may be very boring and error-prone.
+To avoid that, OBus provides a few tools to automatically convert
+introspection data to OCaml definitions.
+
+
+Using tools to generate member definitions
+------------------------------------------
+
+There are two tools that are useful for client-side code:
+``obus-gen-interface`` and ``obus-gen-client``.
+The first one converts an xml introspection document (or an IDL_ file)
+into an OCaml module containing all the caml-ized definitions.
+This generated file is in fact also needed for server-side code.
+Note that files produced by ``obus-gen-interface`` are not meant to be
+edited.
+
+The second tool maps members to their OCaml counterpart: methods are
+mapped to functions, signals to value of type ``OBus_signal.t``
+and properties to values of type ``OBus_property.t``.
+This generated file is meant to be edited. For example, you can edit it in
+order to change the type of values taken/returned by methods.
+
+.. _IDL:
+The IDL language
+----------------
+
+Since editing XML is horrible, OBus provides a intermediate language
+to write dbus interfaces. This language also allows you to
+automatically converts integers to OCaml variants when needed.
+
+The syntax is pretty simple. Here is an example, taken from the OBus
+sources (file ``src/oBus_interfaces.obus``)::
+
+  interface org.freedesktop.DBus {
+    (** A method definition: *)
+    method Hello : () -> (name : string)
+
+    (** Bitwise flags definition: *)
+    flag request_name_flags : uint32 {
+      0b001: allow_replacement
+      0b010: replace_existing
+      0b100: do_not_queue
+    }
+
+    (** Definition of an enumeration: *)
+    enum request_name_result : uint32 {
+      1: primary_owner
+      2: in_queue
+      3: exists
+      4: already_owner
+    }
+
+    (** A method that use newly defined types: *)
+    method RequestName :
+      (name : string, flags : request_name_flags)
+      -> (result : request_name_result)
+  }
+
+All obus tools that accept XML files also accept IDL files. It is also
+possible to convert between IDL and XML with ``obus-idl2xml``
+and ``obus-xml2idl``.
+
+
+Name tracking
+-------------
+
+The owner of a non-unique name may change over time, so OBus provides
+the ``OBus_resolver``, which maps the name to a React signal that holds
+its current owner.
+
+
+-----------------------------------------------------
+
+
+**********************
+Writing D-Bus services
+**********************
+
+In this document we describe the canonical way of writing dbus services
+with OBus.
+
+Local dbus objects are represented by values of type ``OBus_object.t``.
+The main operations on objects are: adding an interface and exporting
+it on a connection. Exporting an object means making it available
+to all peers reachable from the connection.
+
+In order to add callable methods to objects you have to create
+interfaces descriptions (of type ``'a OBus\_object.interface``)
+and add them to objects.
+
+The canonical way to create interfaces with OBus is to first write
+its signature in an XML introspection file or in an OBus IDL file,
+then convert it into an ocaml definition module with
+``obus-gen-interface`` and in a template ocaml source file with
+``obus-gen-server``.
+
+Here is a small example of an interface::
+
+  interface org.Foo.Bar {
+    method GetApplicationName : () -> (name : string)
+      (** Returns the name of the application *)
+  }
+
+It is converted with::
+
+  $ obus-gen-interface foobar.obus -o foobar_interfaces
+  file "foobar_interfaces.ml" written
+  file "foobar_interfaces.mli" written
+  $ obus-gen-server foobar.obus -o foobar
+  file "foobar.ml" written
+
+Now all that you have to do is to edit the file generated by
+``obus-gen-server`` and replace the "Not implemented" errors with
+your code. Once you are done, we're ready to actually create
+the object, add the interface and export it::
+
+  let () = Lwt_main.run begin
+    let%lwt bus = OBus_bus.session () in
+
+    (* Request a name: *)
+    let%lwt _ = OBus_bus.request_name bus "org.Foo.Bar" in
+
+    (* Create the object: *)
+    let obj =
+      OBus_object.make
+        ~interfaces:[Foobar.Org_Foo_Bar.interface]
+        ["plip"]
+    in
+
+    (* Attach it some data: *)
+    OBus_object.attach obj ();
+
+    (* Export the object on the connection *)
+    OBus_object.export bus obj;
+
+    (* Wait forever *)
+    fst (Lwt.wait ())
+  end
+
+Note the you can attach custom data to the object with
+``OBus_object.attach``.
+
+
+---------------------------------------------
+
+
+************************
+One-to-one communication
+************************
+
+Instead of connection to a message bus, you may want to directly connects
+to another application. This can be done with ``OBus_connection.of_addresses``.
+
+If you want to allow other applications to connect to your application
+you have to start a server. Starting a server is very simple, all you
+have to do is to call ``OBus_server.make`` with a callback
+that will receive new connections.
+
+
+-----------------------------------------------------
+
+
+*********************
+Low-level use of OBus
+*********************
+
+This document describes the low-level part of obus.
+
+
+Message filters
+---------------
+
+Message filters are function that are applied to all
+incoming/outgoing messages. Filters are of type::
+
+  type filter = OBus_message.t -> OBus_message.t option
+
+Each filter may use and/or modify the message. If ``None`` is
+returned the message is dropped.
+
+
+Matching rules
+--------------
+
+When using a message bus, an application do not receive messages that
+are not destined to it. In order to receive such messages, one needs to
+add rules on the message bus. All messages matching a rule are sent to
+the application which defined that rule.
+
+There are two ways of adding matching rules: by using the module
+``OBus_bus``, or by using ``OBus_match``.
+The functions ``OBus_bus.add_match`` and ``OBus_bus.remove_match``
+are directly mapped to the corresponding methods of the message bus.
+The function ``OBus_match.export`` is more clever:
+
+- it exports only one time duplicated rules,
+- it exports only the most general rules.
+
+We say that a rule ``r1`` is more general that a rule ``r2``
+if all messages matched by ``r2`` are also matched by
+``r1``. For example, a rule that accepts all messages with
+interface field equal to ``foo.bar`` is more general that a rule
+that accept all messages with interface field equal to
+``foo.bar`` and with member field equal to ``plop``.
+
+Note that you must be careful if you use both modules that
+automatically manage rules (such as ``OBus_signal``, ``OBus_resolver``
+or ``OBus_property``) and ``OBus_bus.add_match`` or ``OBus_bus.remove_match``.
+
+
+Defining new transports
+-----------------------
+
+A transport is a way of receiving and sending messages. The
+``OBus_transport`` module allows to define new transports. If you want
+to create a new transport using the same serialization format as
+default transport, then you can use the ``OBus_wire`` module.
+
+By defining new transports, you can for example write an application
+that forward messages over the network in very few lines of code.
+
+
+Defining new authentication mechanisms
+--------------------------------------
+
+When openning a connection, before we can send and receive message
+over it, dbus requires a authentication procedure. OBus implements
+both client and server side authentication.  The ``OBus_auth``
+allow to write new client and server side authentication mechanisms.
diff --git a/docs/manual/manual.tex b/docs/manual/manual.tex
new file mode 100644
index 0000000..55f53d3
--- /dev/null
+++ b/docs/manual/manual.tex
@@ -0,0 +1,801 @@
+% manual.tex
+% ----------
+% Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+% Licence   : BSD3
+%
+% This file is a part of obus, an ocaml implementation of D-Bus.
+
+\documentclass{article}
+\usepackage{fullpage}
+\usepackage[utf8]{inputenc}
+\usepackage{url}
+\usepackage{hyperref}
+\usepackage{listings}
+\usepackage{xcolor}
+\usepackage{xspace}
+
+%% +------------------------------------------------------------------+
+%% | Configuration                                                    |
+%% +------------------------------------------------------------------+
+
+\hypersetup{%
+  a4paper=true,
+  pdfstartview=FitH,
+  colorlinks=false,
+  pdfborder=0 0 0,
+  pdftitle = {OBus user manual},
+  pdfauthor = {Jérémie Dimino},
+  pdfkeywords = {OCaml, D-Bus}
+}
+
+\lstset{
+  language=[Objective]Caml,
+  extendedchars,
+  showspaces=false,
+  showstringspaces=false,
+  showtabs=false,
+  basicstyle=\ttfamily,
+  frame=l,
+  framerule=1.5mm,
+  xleftmargin=6mm,
+  framesep=4mm,
+  rulecolor=\color{lightgray},
+  emph={lwt,for\_lwt,try\_lwt,raise\_lwt},
+  emphstyle=\color[rgb]{0.627451, 0.125490, 0.941176},
+  moredelim=*[s][\itshape]{(*}{*)},
+  moredelim=[is][\textcolor{darkgray}]{§}{§},
+  escapechar=°,
+  keywordstyle=\color[rgb]{0.627451, 0.125490, 0.941176},
+  stringstyle=\color[rgb]{0.545098, 0.278431, 0.364706},
+  commentstyle=\color[rgb]{0.698039, 0.133333, 0.133333},
+  numberstyle=\color[rgb]{0.372549, 0.619608, 0.627451}
+}
+
+%% +-----------------------------------------------------------------+
+%% | Aliases                                                         |
+%% +-----------------------------------------------------------------+
+
+\newcommand{\obus}{\texttt{OBus}\xspace}
+\newcommand{\dbus}{\texttt{D-Bus}\xspace}
+
+%% +-----------------------------------------------------------------+
+%% | Headers                                                         |
+%% +-----------------------------------------------------------------+
+
+\title{OBus user manual}
+\author{Jérémie Dimino}
+
+\begin{document}
+
+\maketitle
+
+%% +-----------------------------------------------------------------+
+%% | Abstract                                                        |
+%% +-----------------------------------------------------------------+
+
+\begin{abstract}
+
+  \dbus is an inter-processes communication protocol, or IPC for
+  short, which has recently become a standard on desktop oriented
+  computers. It is now possible to talk to a lot application using
+  \dbus. Moreover, it has many bindings/implementations for differents
+  languages, which make it easily accessible. \obus is a pure OCaml
+  implementation of this protocol. What makes it different from other
+  bindings/implementations is that it is the only one using
+  cooperative threads, which make it very simple to fully exploit the
+  asynchronous nature of D-Bus.
+
+  \textbf{Note:} it is advised to have some knowledge about the
+  \texttt{Lwt} library before reading this manual.
+\end{abstract}
+
+%% +-----------------------------------------------------------------+
+%% | Table of contents                                               |
+%% +-----------------------------------------------------------------+
+
+\setcounter{tocdepth}{2}
+\tableofcontents
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Introduction}
+
+\subsection{Overview of \obus}
+
+\subsubsection{Packages}
+
+The main packages of the \obus distribution is the \obus package,
+available via findlib. It contains the core library. Moveover, \obus
+although provides packages for using a bunch of services of the
+Freedesktop project:
+
+\begin{itemize}
+\item \texttt{obus.hal}
+\item \texttt{obus.notification}
+\item \texttt{obus.network-manager}
+\item \texttt{obus.policykit}
+\item \texttt{obus.udisks}
+\item \texttt{obus.upower}
+\end{itemize}
+
+The use of these packages is straightforward and you need to know
+almost nothing about \dbus or \obus. For example, here is a program
+which open a popup notification:
+
+\begin{lstlisting}
+open Notification
+
+lwt () =
+  lwt id = Notification.notify ~summary:"Hello, world!" () in
+  return ()
+\end{lstlisting}
+
+Lastly \obus also provides a syntax extension (package
+\texttt{obus.syntax}) and a parser/printer for the IDL language
+(package \texttt{obus.idl}).
+
+\subsubsection{Modules}
+
+\obus contains about 30 public modules. But do not be scared, most of
+the time you will need a very small subset of them. These modules can
+be divided in two categories:
+
+\begin{itemize}
+\item{the high-level API}
+\item{the low-level API}
+\end{itemize}
+
+The low-level API is described in the section ~\ref{lowlevel-section}
+of this manual. Note that you must have a good knowledge of \dbus to
+use it.
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Quick start}
+
+In this section we explain how to quickly uses a \dbus service using
+\obus.
+
+\begin{itemize}
+\item The first step is to obtain the introspection of the
+  service. Some applications put theses file into
+  \texttt{/usr/share/dbus-1/interfaces/}. Otherwise you can get it by
+  introspecting a running service, for example:
+
+  \lstset{language=bash}
+  \begin{lstlisting}
+$ obus-introspect -rec org.foo.bar / > foo.xml
+  \end{lstlisting}
+
+  will recursivelly introspect the service named \texttt{org.foo.bar}
+  and put all the interfaces it implements into \texttt{foo.xml}.
+
+\item The second step is to turn this file into an ocaml module which
+  contains the description of the interface:
+
+  \lstset{language=bash}
+  \begin{lstlisting}
+$ obus-gen-interface foo.xml
+  \end{lstlisting}
+
+  This will create the two files \texttt{foo\_interfaces.ml} and
+  \texttt{foo\_interfaces.ml}.
+
+\item The final step is to turn the introspection file into a module
+  for client-side use:
+
+  \lstset{language=bash}
+  \begin{lstlisting}
+$ obus-gen-client foo.xml
+  \end{lstlisting}
+
+  This will produce the two files \texttt{foo\_client.mli} and
+  \texttt{foo\_client.ml}. These two files can be edited, and must be
+  compiled with the \texttt{lwt.syntax} syntax extension.
+\end{itemize}
+
+After that, you can use \texttt{Foo\_client} module to access the
+service.  Methods are mapped to functions returning a \texttt{lwt}
+thread, signals are mapped to values of type \texttt{OBus\_signal.t},
+and properties to values of type \texttt{OBus\_property.t}. For
+example:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+lwt () =
+  (* Connect to the session bus *)
+  lwt bus = OBus_bus.session () in
+
+  (* Create a proxy for a remote object *)
+  let proxy =
+    OBus_proxy.make
+      (OBus_peer.make bus "org.foo.bar")
+      ["org"; "foo"; "bar"]
+  in
+
+  (* Call a method of the servivce *)
+  lwt result = Foo_client.Org_foo_bar.plop proxy ... in
+
+  (* Connect to a signal of the service *)
+  lwt () =
+    Lwt_react.E.notify (fun args -> ...)
+    =|< OBus_signal.connect (Foo_client.Org_foo_bar.plip proxy)
+  in
+
+  (* Read the contents of a property *)
+  lwt value = OBus_property.get (Foo_client.Org_foo_bar.plap proxy) in
+
+  ...
+\end{lstlisting}
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Basis}
+
+In this section we will describe the minimum you must know to use
+\obus and interfaces for \dbus services written with \obus (like the
+ones provided in the \obus distribution: \texttt{obus.notification},
+\texttt{obus.upower}, \dots).
+
+\subsection{Connections and message buses}
+
+A \emph{connection} is a way of exchanging messages with another
+application speaking the \dbus protocol. Most of the time applications
+use connection to a special application called a \emph{message bus}. A
+message bus act as a router between several applications. On a desktop
+computer, there are two well-known instances: the \emph{system}
+message bus, and the user \emph{session} message bus.
+
+The first one is unique given a computer, and use security
+policies. The second is unique given a user session. Its goal is to
+allow programs running in the session to talk to each other. \obus
+offers two function for connecting to these message buses:
+\texttt{OBus\_bus.session} and \texttt{OBus\_bus.system}.
+
+The session bus exists for the life-time of a user session. It exits
+when the session is closed, and any programs using it should exit to,
+that is why \obus will exit the program when the connection to the
+session bus is lost. However this behavior can be changed.
+
+On the other hand the system bus can be restarted and program using it
+may try to reopen the connection. System-wide application should
+handle the lost of the connection with the system bus.
+
+Here is a small example which connects the session bus and prints its
+id:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open Lwt
+
+lwt () =
+  (* Open a connection to the session message bus: *)
+  lwt bus = OBus_bus.session () in
+
+  (* Obtain its id: *)
+  lwt id = OBus_bus.get_id bus in
+
+  Lwt_io.printlf "The session bus id is %d." (OBus_uuid.to_string id)
+\end{lstlisting}
+
+\subsection{Names}
+
+On a message bus, applications are referenced using names. There is a
+special category of names called \emph{unique names}. Each time an
+application connects to a bus, the bus give it a unique name. Unique
+name are of the form \texttt{:1.42} and cannot be changed. You can
+think of a unique name as an \emph{ip} (such as
+\texttt{192.168.1.42}).
+
+Once connected, the unique name can is returned by the function
+\texttt{OBus\_bus.name}.  Here is an example of a program that prints
+its unique name:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open Lwt
+
+lwt () =
+  (* Connects to the session bus: *)
+  lwt bus = OBus_bus.session () in
+
+  (* Read our unique name: *)
+  let name = OBus_bus.name bus in
+
+  Lwt_io.printlf "My unique connection name is %s." name
+\end{lstlisting}
+
+Unique name are usefull to uniquelly identify an application. However
+when you want to use a specific service you may prefer using a
+well-known name such as \texttt{org.freedesktop.Notifications}. \dbus
+allows applications to own as many non-unique names as they want. You
+can think of a non-unique name as a \emph{dns} (such as
+``obus.forge.ocamlcore.org'').
+
+Names can be requested or resolved using functions of the
+\texttt{OBus\_bus} module.
+
+Here is an example:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open Lwt
+
+lwt () =
+  lwt bus = OBus_bus.session () in
+
+  lwt () =
+    try_lwt
+      (* Try to resolve a name, this may fail if nobody owns it: *)
+      lwt owner = OBus_bus.get_name_owner bus "org.freedesktop.Notifications" in
+      Lwt_io.printlf "The owner is %d."
+    with OBus_bus.Name_has_no_owner msg ->
+      Lwt_io.printlf "Cannot resolve the name: %s." msg
+  in
+
+  (* Request a name: *)
+  OBus_bus.request_name bus "org.foo.bar" >>= function
+    | `Primary_owner ->
+        Lwt_io.printl "I own the name org.foo.bar!"
+    | `In_queue ->
+        Lwt_io.printl "Somebody else owns the name, i am in the queue."
+    | `Exists ->
+        Lwt_io.printl "Somebody else owns the name\
+                       and does not want to loose it :(."
+    | `Already_owner
+        (* Cannot happen *)
+        Lwt_io.printl "I already owns this name."
+\end{lstlisting}
+
+Note that the \texttt{OBus\_resolver} module offer a better way of
+resolving names and monitoring name owners. See section
+~\ref{name-tracking} for details.
+
+\subsection{Peers}
+
+A \emph{peer} represent an application accessible through a \dbus
+connection.  To uniquelly identify a peer one needs a connection and a
+name. The module \texttt{OBus\_peer} defines the type type of
+peers. There are two requests that should be available on all peers:
+\texttt{ping} and \texttt{get\_machine\_id}.  The first one just ping
+the peer to see if it is alive, and the second returns the id of the
+machine the peer is currently running on.
+
+\subsection{Objects and proxies}
+
+In order to export services, \dbus uses the concept of
+\emph{objects}. An application may holds as many objects as it
+wants. From the inside of the application, \dbus objects are generally
+mapped to language native objects. From the outside, objects are
+refered by \emph{object-paths}, which looks like
+``\texttt{/org/freedesktop/DBus}''. You can think of an object path as
+a pointer.
+
+Objects may have members which are organized by interfaces (such as
+``\texttt{org.freedesktop.DBus}'').  There are three types of members:
+
+\begin{itemize}
+\item Methods
+\item Signals
+\item Properties
+\end{itemize}
+
+Methods act like functions. Clients can call methods of
+objects. Signals are spontaneous events that may occurs at any
+time. Clients may register to these signals and then be notified when
+a signal arrive. Properties act as variable, that can be read and/or
+written and sometimes monitored.
+
+In order to uniquelly identify an object, we need its path and the
+peer that owns it. We call such a thing a \emph{proxy}. Proxies are
+defined in the module \texttt{OBus\_proxy}.
+
+Here is a simple example on how to call a method on a proxy (we will
+explain latter what means the \texttt{C.seq...} things):
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open Lwt
+open OBus_value
+
+lwt () =
+  lwt bus = OBus_bus.session () in
+
+  (* Create the peer: *)
+  let peer = OBus_peer.make ~name:"org.freedesktop.DBus" ~connection:bus in
+
+  (* Create the proxy: *)
+  let proxy = OBus_proxy.make ~peer ~path:["org"; "freedesktop"; "DBus"] in
+
+  (* Call a method: *)
+  lwt id =
+    OBus_proxy.call proxy
+      ~interface:"org.freedesktop.DBus"
+      ~member:"GetId"
+      ~i_args:C.seq0
+      ~o_args:(C.seq1 C.basic_string)
+      ()
+  in
+
+  Lwt_io.printlf "The bus id is: %s" id
+\end{lstlisting}
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Interaction between the OCaml world and the D-Bus world}
+
+\subsection{Value mapping}
+
+\dbus defines its own type system, which is used to serialize and
+deserialize messages. These types are defined in the module
+\texttt{OBus\_value.T} and \dbus values that are defined in the module
+\texttt{OBus\_value.V}. When a message is received, its contents is
+represented as a value of type \texttt{OBus\_value.V.sequence}.
+Simillary, when a message is sent, it is first converted into this
+format.
+
+Manipulating boxed \dbus values is not very handy. To make the
+interaction more transparent, \obus defines a set of type combinators
+which allow to easilly switch between the \dbus representation and the
+ocaml representation. These convertors are defined in the module
+\texttt{OBus\_value.C}.
+
+Here is an example of convertion (in the toplevel):
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+# open OBus_value;;
+
+(* Make a D-Bus value from an ocaml one: *)
+# C.make_sequence (C.seq2 C.basic_int32 (C.array C.basic_string)) (42l, ["foo"; "bar"]);;
+- : OBus_value.V.sequence =
+[OBus_value.V.Basic (OBus_value.V.Int32 42l);
+ OBus_value.V.Array (OBus_value.T.Basic OBus_value.T.String,
+  [OBus_value.V.Basic (OBus_value.V.String "foo");
+   OBus_value.V.Basic (OBus_value.V.String "bar")])]
+
+(* Cast a D-Bus value to an ocaml one: *)
+# C.cast_sequence (C.seq1 C.basic_string) [V.basic(V.string "foobar")];;
+- : string = "foobar"
+
+(* Try to cast a D-Bus value to an ocaml one with the wrong type: *)
+# C.cast_sequence (C.seq1 C.basic_string) [V.basic(V.int32 0l)];;
+Exception: OBus_value.C.Signature_mismatch.
+\end{lstlisting}
+
+\subsection{Errors mapping}
+
+A call to a method may fails. In this case the service sends an error
+to the caller.  \dbus errors are mapped to ocaml exceptions by the
+\texttt{OBus\_error} module.  Basically, to defines a mapping between
+an exception and a \dbus error, here is what you have to do:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+exception My_exn of string
+
+let module M = OBus_error.Register(struct
+                                     exception E = My_exn
+                                     let name = "org.foo.bar.MyError"
+                                   end)
+in ()
+\end{lstlisting}
+
+  Or, if you use the syntax extension:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+exception My_exn of string
+  with obus("org.foo.bar.MyError")
+\end{lstlisting}
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Using D-Bus services}
+
+In this section we describe the canonical way of using a \dbus service
+with \obus.
+
+\subsection{Defining and using members}
+
+For all types of members (methods, signals and properties), \dbus
+provides types to defines them and functions to use these
+definitions. A member definition contains all the information about a
+member. For example, here is the definition of a method call named
+``foo'' on interface ``org.foo.bar'' which takes a string and returns
+an 32-bits signed integer:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open OBus_member
+
+let m_Foo = {
+  Method.interface = "org.foo.bar";
+  Method.member = "Foo";
+  Method.i_args = C.seq1 C.basic_string;
+  Method.o_args = C.seq1 C.basic_int32;
+  Method.annotations = [];
+}
+\end{lstlisting}
+
+Once a member is defined, it can be used by the corresponding modules:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+open Lwt
+open OBus_members
+
+(* Definition of a method *)
+let m_GetId = {
+  Method.interface = "org.freedesktop.DBus";
+  Method.member = "GetId";
+  Method.i_args = C.seq0;
+  Method.o_args = C.seq1 C.basic_string;
+  Method.annotations = [];
+}
+
+(* Definition of a signal *)
+let s_NameAcquired = {
+  Signal.interface = "org.freedesktop.DBus";
+  Signal.member = "NameAcquired";
+  Signal.args = C.seq1 (C.basic C.string);
+  Signal.annotations = [];
+}
+
+lwt () =
+  lwt bus = OBus_bus.session () in
+  let proxy =
+    OBus_proxy.make
+      (OBus_peer.make bus "org.freedesktop.DBus")
+      ["org"; "freedesktop"; "DBus"]
+  in
+
+  (* Call the method we just defined: *)
+  lwt id = OBus_method.call m_GetId proxy () in
+
+  (* Register to the signal we just defined: *)
+  lwt event = OBus_signal.connect (OBus_signal.make s_NameAcquired proxy) in
+
+  Lwt_react.E.notify_p
+    (fun name ->
+       Lwt_io.printlf "name acquired: %s" name)
+    event;
+
+  Lwt_io.printlf "The message bus id is %s" id
+\end{lstlisting}
+
+Of course, writting definitions by hand may be very boring and
+error-prone. To avoid that \obus can automatically convert
+introspection data into ocaml definitions.
+
+\subsection{Using tools to generate member definitions}
+
+There are two tools that are usefull for client-side code:
+\texttt{obus-gen-interface} and \texttt{obus-gen-client}. The first
+one converts an xml introspection document (or an idl file) into an
+ocaml module containing all the camlized definitions. This generated
+file is in fact also needed for server-side code. Note that fiels
+produced by \texttt{obus-gen-interface} are not meant to be edited.
+
+The second tool maps members into their ocaml counterpart: methods are
+mapped to functions, signals to value of type \texttt{OBus\_signal.t}
+and properties to values of type \texttt{OBus\_property.t}.  This
+generated file is meant to be edited. For example, you can edit it in
+order to change the type of values taken/returned by methods.
+
+\subsection{The \obus IDL language}
+
+Since editing XML is horrible, \obus provides a intermediate language
+to write \dbus interfaces. Moreover this language allow you to
+automatically converts integers to ocaml variants when needed.
+
+The syntax is pretty simple. Here is an example, taken from \obus
+sources (file \texttt{src/oBus\_interfaces.obus}):
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+interface org.freedesktop.DBus {
+  (** A method definition: *)
+  method Hello : () -> (name : string)
+
+  (** Bitwise flags definition: *)
+  flag request_name_flags : uint32 {
+    0b001: allow_replacement
+    0b010: replace_existing
+    0b100: do_not_queue
+  }
+
+  (** Definition of an enumeration: *)
+  enum request_name_result : uint32 {
+    1: primary_owner
+    2: in_queue
+    3: exists
+    4: already_owner
+  }
+
+  (** A method that use newly defined types: *)
+  method RequestName :
+    (name : string, flags : request_name_flags)
+    ->
+    (result : request_name_result)
+}
+\end{lstlisting}
+
+All \obus tools that accept XML files also accept IDL files. Moreover
+it is possible to convert them by using \texttt{obus-idl2xml} and
+\texttt{obus-xml2idl}.
+
+\subsection{Name tracking}
+\label{name-tracking}
+
+The owner of a on-unique name may change over the time. \obus provides
+the \texttt{OBus\_resolver} module to deals with it. The owner is
+mapped into a React's signal holding the current owner of a name.
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Writing D-Bus services}
+
+In this section we describe the canonical way of writing \dbus
+services with \obus.
+
+Local \dbus objects are represented by values of type
+\texttt{OBus\_object.t}. The main operations on objects are: adding an
+interface and exporting it on a connection.  Exporting an object means
+making it available to all peers reachable from the connection.
+
+In order to add callable methods to objects you have to create
+interfaces descriptions (of type \texttt{'a OBus\_object.interface})
+and add them to objects.
+
+The canonical way to create interfaces with \obus is to first write
+its signature in an XML introspection file or in an \obus idl file,
+then convert it into an ocaml definition module with
+\texttt{obus-gen-interface} and in a template ocaml source file with
+\texttt{obus-gen-server}.
+
+Here is a small example of interface:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+interface org.Foo.Bar {
+  method GetApplicationName : () -> (name : string)
+    (** Returns the name of the application *)
+}
+\end{lstlisting}
+
+It is converted with:
+
+\lstset{language=bash}
+\begin{lstlisting}
+$ obus-gen-interface foobar.obus -o foobar_interfaces
+file "foobar_interfaces.ml" written
+file "foobar_interfaces.mli" written
+$ obus-gen-server foobar.obus -o foobar
+file "foobar.ml" written
+\end{lstlisting}
+
+Now all that you have to do is to edit the file generated by
+\texttt{obus-gen-server} and replace the ``Not implemented'' errors by
+your code.
+
+Once it is done, here is how to actually create the object, add the
+interface and export it:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+lwt () =
+  lwt bus = OBus_bus.session () in
+
+  (* Request a name: *)
+  lwt _ = OBus_bus.request_name bus "org.Foo.Bar" in
+
+  (* Create the object: *)
+  let obj =
+    OBus_object.make
+      ~interfaces:[Foobar.Org_Foo_Bar.interface]
+      ["plip"]
+  in
+
+  (* Attach it some data: *)
+  OBus_object.attach obj ();
+
+  (* Export the object on the connection *)
+  OBus_object.export bus obj;
+
+  (* Wait forever *)
+  fst (wait ())
+\end{lstlisting}
+
+Note the you can attach custom data to the object with
+\texttt{OBus\_object.attach}.
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{One-to-one communication}
+
+Instead of connection to a message bus, you may want to directly
+connects to another application. This can be done with
+\texttt{OBus\_connection.of\_addresses}.
+
+If you want to allow other applications to connect to your application
+then you have to start a server. Starting a server is very simple, all
+you have to do is to call \texttt{OBus\_server.make} with a callback
+that will receive new connections.
+
+%% +-----------------------------------------------------------------+
+%% | Section                                                         |
+%% +-----------------------------------------------------------------+
+\section{Low-level use of D-Bus}
+\label{lowlevel-section}
+
+This section describes the low-level part of \obus.
+
+\subsection{Message filters}
+
+Message filters are function that are applied to all
+incomming/outgoing messages. Filters are of type:
+
+\lstset{language=[Objective]Caml}
+\begin{lstlisting}
+type filter = OBus_message.t -> OBus_message.t option
+\end{lstlisting}
+
+Each filter may use and/or modify the message. If \texttt{None} is
+returned the message is dropped.
+
+\subsection{Matching rules}
+
+When using a message bus, an application do not receive messages that
+are not destined to it. In order to receive such messages, one need to
+add rules on the message bus. All messages matching a rule are sent to
+the application which defined that rule.
+
+There are two ways of adding matching rules: by using the module
+\texttt{OBus\_bus}, or by using \texttt{OBus\_match}. The functions
+\texttt{OBus\_bus.add\_match} and \texttt{OBus\_bus.remove\_match} are
+directly mapped to the corresponding methods of the message bus. The
+function \texttt{OBus\_match.export} is more clever:
+
+\begin{itemize}
+\item it exports only one time duplicated rules,
+\item it exports only the most general rules.
+\end{itemize}
+
+We say that a rule \texttt{r1} is more general that a rule \texttt{r2}
+if all messages matched by \texttt{r2} are also matched by
+\texttt{r1}.  For example a rule that accept all messages with
+interface field equal to \texttt{foo.bar} is more general that a rule
+that accept all messages with interface field equal to
+\texttt{foo.bar} and with member field equal to \texttt{plop}.
+
+Note that you must be carefull if you use both modules that
+automatically manage rules (such as \texttt{OBus\_signal},
+\texttt{OBus\_resolver} or \texttt{OBus\_property}) and
+\texttt{OBus\_bus.add\_match} or \texttt{OBus\_bus.remove\_match}.
+
+\subsection{Defining new transports}
+
+A transport is a way of receiving and sending messages. The
+\texttt{OBus\_transport} allow to defines new transports. If you want
+to create a new transport that use the same serialization format as
+default transport, then you can use the \texttt{OBus\_wire} module.
+
+By definning new transports, you can for example write an application
+that forward messages over the network in a very few lines of code.
+
+\subsection{Defining new authentication mechanisms}
+
+When openning a connection, before we can send and receive message
+over it, \dbus requires a authentication procedure. \obus implements
+both client and server side authentication.  The \texttt{OBus\_auth}
+allow to write new client and server side authentication mechanisms.
+
+\end{document}
diff --git a/dune b/dune
new file mode 100644
index 0000000..dbff269
--- /dev/null
+++ b/dune
@@ -0,0 +1,5 @@
+(env
+ (release
+   (flags (:standard -w -3-6-7-9-27-32-33-34-35-37-38-39)))
+ (dev
+   (flags (:standard -w -3-6-7-9-27-32-33-34-35-37-38-39))))
\ No newline at end of file
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..ba417fe
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.4)
+(using menhir 2.0)
diff --git a/examples/battery_monitoring.ml b/examples/battery_monitoring.ml
new file mode 100644
index 0000000..216126d
--- /dev/null
+++ b/examples/battery_monitoring.ml
@@ -0,0 +1,76 @@
+(*
+ * battery_monitoring.ml
+ * ---------------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt_react
+open Lwt
+open Lwt_io
+
+(* List of monitored batteries. *)
+let batteries = ref []
+
+let print_state device state =
+  printlf "state of %s: %s"
+    (OBus_path.to_string (OBus_proxy.path (UPower_device.to_proxy device)))
+    (match state with
+       | `Unknown -> "unknown"
+       | `Charging -> "charging"
+       | `Discharging -> "discharging"
+       | `Empty -> "empty"
+       | `Fully_charged -> "fully charged"
+       | `Pending_charge -> "pending charge"
+       | `Pending_discharge -> "pending discharge")
+
+(* Handle device addition. *)
+let monitor_device device =
+  if List.exists (fun (device', _, _) -> device = device') !batteries then
+    return ()
+  else begin
+    let switch = Lwt_switch.create () in
+    let%lwt signal = OBus_property.monitor (UPower_device.state device) in
+    let%lwt s = S.map_s (print_state device) signal in
+    batteries := (device, switch, s) :: !batteries;
+    return ()
+  end
+
+(* Handle device removal. *)
+let unmonitor_device device =
+  let%lwt () =
+    Lwt_list.iter_p
+      (fun (device', switch, s) ->
+         if device = device' then begin
+           S.stop s;
+           Lwt_switch.turn_off switch
+         end else
+           return ())
+      !batteries
+  in
+  batteries := List.filter (fun (device', _, _) -> device <> device') !batteries;
+  return ()
+
+let () = Lwt_main.run begin
+  (* Get the manager proxy. *)
+  let%lwt manager = UPower.daemon () in
+
+  (* Handle device addition/removal. *)
+  let%lwt () =
+    OBus_signal.connect (UPower.device_added manager)
+    >|= E.map_p monitor_device
+    >|= E.keep
+  and () =
+    OBus_signal.connect (UPower.device_removed manager)
+    >|= E.map_p unmonitor_device
+    >|= E.keep
+  in
+
+  (* Monitor all the batteries initially present on the system. *)
+  let%lwt devices = UPower.enumerate_devices manager in
+  let%lwt () = Lwt_list.iter_p monitor_device devices in
+
+  fst (wait ())
+end
diff --git a/examples/bus_functions.ml b/examples/bus_functions.ml
new file mode 100644
index 0000000..9e120e4
--- /dev/null
+++ b/examples/bus_functions.ml
@@ -0,0 +1,55 @@
+(*
+ * bus_functions.ml
+ * ----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* This sample illustrate use if some of the functions offered by the
+   message bus *)
+
+open Lwt
+open Lwt_react
+open Lwt_io
+
+let service = "org.freedesktop.Notifications"
+let name = "org.ocamlcore.forge.obus"
+
+module String_set = Set.Make(String)
+
+let () = Lwt_main.run begin
+  let%lwt bus = OBus_bus.session () in
+
+  let%lwt id = OBus_bus.get_id bus in
+  let%lwt () = printlf "the message bus id is: %S" (OBus_uuid.to_string id) in
+
+  let%lwt names = OBus_bus.list_names bus in
+  let%lwt () = printlf "names on the session bus:" in
+  let%lwt () = Lwt_list.iter_p (printlf "  %s") names in
+
+  let%lwt names = OBus_bus.list_activatable_names bus in
+  let%lwt () = printlf "these names are activatable:" in
+  let%lwt () = Lwt_list.iter_p (printlf "  %s") names in
+
+  let%lwt () = printf "trying to start service %S: " service in
+  let%lwt result = OBus_bus.start_service_by_name bus service in
+  let%lwt () = printl
+    (match result with
+       | `Success -> "success"
+       | `Already_running -> "already running")
+  in
+
+  let%lwt () = printf "trying to acquire the name %S: " name in
+  let%lwt result = OBus_bus.request_name bus ~replace_existing:true ~do_not_queue:true name in
+  let%lwt () = printl
+    (match result with
+       | `Primary_owner -> "success"
+       | `In_queue -> "in queue"
+       | `Exists -> "the name already exists"
+       | `Already_owner -> "i already own the name")
+  in
+
+  printlf "my names are: %s" (String.concat ", " (String_set.elements (S.value (OBus_bus.names bus))))
+end
diff --git a/examples/dune b/examples/dune
new file mode 100644
index 0000000..b2eefac
--- /dev/null
+++ b/examples/dune
@@ -0,0 +1,46 @@
+(alias
+ (name examples)
+ (deps bus_functions.exe hello.exe list_services.exe monitor.exe eject.exe signals.exe
+       battery_monitoring.exe network_manager.exe notify.exe ping.exe pong.exe))
+
+(executables
+ (names      bus_functions hello list_services monitor)
+ (modules    bus_functions hello list_services monitor)
+ (libraries  lwt obus)
+ (preprocess (pps lwt_ppx)))
+
+(executables
+ (names      eject signals)
+ (modules    eject signals)
+ (libraries  lwt obus obus_hal)
+ (preprocess (pps lwt_ppx)))
+
+(executable
+ (name       battery_monitoring)
+ (modules    battery_monitoring)
+ (libraries  lwt obus obus_upower)
+ (preprocess (pps lwt_ppx)))
+
+(executable
+ (name       network_manager)
+ (modules    network_manager)
+ (libraries  lwt obus obus_network_manager)
+ (preprocess (pps lwt_ppx)))
+
+(executable
+ (name       notify)
+ (modules    notify)
+ (libraries  lwt obus obus_notification)
+ (preprocess (pps lwt_ppx)))
+
+(executables
+ (names      ping pong)
+ (modules    ping pong ping_pong)
+ (libraries  lwt obus)
+ (preprocess (pps lwt_ppx)))
+
+(rule
+ (targets ping_pong.ml ping_pong.mli)
+ (deps    ping_pong.xml)
+ (action
+  (run obus-gen-interface -keep-common -o ping_pong %{deps})))
diff --git a/examples/eject.ml b/examples/eject.ml
new file mode 100644
index 0000000..ef922d0
--- /dev/null
+++ b/examples/eject.ml
@@ -0,0 +1,24 @@
+(*
+ * eject.ml
+ * --------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Simple sample which eject all cdroms using Hal *)
+
+open Lwt
+open Lwt_io
+
+let () = Lwt_main.run begin
+  let%lwt manager = Hal_manager.manager () in
+  let%lwt cdroms = Hal_manager.find_device_by_capability manager "storage.cdrom" in
+  let%lwt () = printlf "cdrom(s) found: %d" (List.length cdroms) in
+  Lwt_list.iter_p begin function cdrom ->
+    let%lwt () = printlf "eject on device %s" (OBus_path.to_string (OBus_proxy.path (Hal_device.to_proxy cdrom))) in
+    let%lwt _ = Hal_device.Storage.eject cdrom [] in
+    return ()
+  end cdroms
+end
diff --git a/examples/hello.ml b/examples/hello.ml
new file mode 100644
index 0000000..4548992
--- /dev/null
+++ b/examples/hello.ml
@@ -0,0 +1,16 @@
+(*
+ * hello.ml
+ * --------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Just open a connection with the message bus and print the assigned
+   unique name *)
+
+let () = Lwt_main.run begin
+  let%lwt bus = OBus_bus.session () in
+  Lwt_io.printlf "My unique connection name is: %s" (OBus_connection.name bus)
+end
diff --git a/examples/list_services.ml b/examples/list_services.ml
new file mode 100644
index 0000000..44b7da1
--- /dev/null
+++ b/examples/list_services.ml
@@ -0,0 +1,33 @@
+(*
+ * list_services.ml
+ * ----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* List services with their owner *)
+
+open Lwt
+open Lwt_io
+
+let list name get_bus =
+  let%lwt () = printlf "service name mapping on %s bus:" name in
+  let%lwt bus = get_bus () in
+
+  (* Get the list of all names on the session bus *)
+  let%lwt names = OBus_bus.list_names bus in
+
+  Lwt_list.iter_p
+    (fun name ->
+      let%lwt owner = OBus_bus.get_name_owner bus name in
+       printlf "  %s -> %s" owner name)
+
+    (* Select only names which are not connection unique names *)
+    (List.filter (fun s -> s.[0] <> ':') names)
+
+let () = Lwt_main.run begin
+  let%lwt () = list "session" OBus_bus.session in
+  list "system" OBus_bus.system
+end
diff --git a/examples/monitor.ml b/examples/monitor.ml
new file mode 100644
index 0000000..f24649f
--- /dev/null
+++ b/examples/monitor.ml
@@ -0,0 +1,34 @@
+(*
+ * monitor.ml
+ * ----------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* This sample illustrate the use of threads in D-Bus + use of
+   filters. Filters are part of the lowlevel api. *)
+
+open Lwt
+open OBus_bus
+open OBus_message
+open OBus_value
+
+let filter what_bus message =
+  Format.printf "@[<hv 2>message intercepted on %s bus:@\n%a@]@." what_bus OBus_message.print message;
+  (* Drop the message so we do not respond to method call *)
+  None
+
+let add_filter what_bus get_bus =
+  let%lwt bus = get_bus () in
+  let _ = Lwt_sequence.add_r (filter what_bus) (OBus_connection.incoming_filters bus) in
+  Lwt_list.iter_p
+    (fun typ -> OBus_bus.add_match bus (OBus_match.rule ~typ ()))
+    [ `Method_call; `Method_return; `Error; `Signal ]
+
+let () = Lwt_main.run begin
+  let%lwt () = add_filter "session" OBus_bus.session <&> add_filter "system" OBus_bus.system in
+  let%lwt () = Lwt_io.printlf "type Ctrl+C to stop" in
+  fst (wait ())
+end
diff --git a/examples/network_manager.ml b/examples/network_manager.ml
new file mode 100644
index 0000000..40fb957
--- /dev/null
+++ b/examples/network_manager.ml
@@ -0,0 +1,49 @@
+(*
+ * network_manager.ml
+ * ------------------
+ * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* This example illustrate the use of OBus to detect network-manager
+   connections. *)
+
+open Lwt_react
+open Lwt
+open Lwt_io
+open OBus_value
+
+let () = Lwt_main.run begin
+  (* Get the manager. *)
+  let%lwt manager = Nm_manager.daemon () in
+
+  (* Create a signal descriptor for listenning on signals comming from
+     any DHCP4 object. *)
+  let sig_desc =
+    OBus_signal.make_any
+      Nm_interfaces.Org_freedesktop_NetworkManager_DHCP4Config.s_PropertiesChanged
+      (Nm_manager.to_peer manager)
+  in
+
+  (* Connects to this signal. *)
+  let%lwt event = OBus_signal.connect sig_desc in
+
+  (* Prints all DHCP4 options when one configuration changes. *)
+  E.keep
+    (E.map_s
+       (fun (proxy, properties) ->
+          match try Some(List.assoc "Options" properties) with Not_found -> None with
+            | Some options ->
+                let%lwt () = printlf "DHCP options for %S:" (OBus_path.to_string (OBus_proxy.path proxy)) in
+                Lwt_list.iter_s
+                  (fun (key, value) ->
+                     printlf "  %s = %s" key (V.string_of_single value))
+                  (C.cast_single (C.dict C.string C.variant) options)
+            | None ->
+                return ())
+       event);
+
+  fst (wait ())
+end
diff --git a/examples/notify.ml b/examples/notify.ml
new file mode 100644
index 0000000..86ace21
--- /dev/null
+++ b/examples/notify.ml
@@ -0,0 +1,32 @@
+(*
+ * notify.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
+open Lwt_io
+
+let () = Lwt_main.run begin
+  (* Open a first notification: *)
+  let%lwt _ = Notification.notify ~summary:"Hello, world!" ~body:"ocaml is fun!" ~icon:"info" () in
+
+  let%lwt () = Lwt_unix.sleep 0.5 in
+
+  (* Open another one, with buttons on it: *)
+  let%lwt handle =
+    Notification.notify ~summary:"Actions test" ~body:"click on something!"
+      ~category:"network"
+      ~actions:[("coucou", `Coucou); ("plop", `Plop)] ()
+  in
+
+  (* Then wait for the result: *)
+  Notification.result handle >>= function
+    | `Coucou -> eprintl "You pressed coucou!"
+    | `Plop -> eprintl "You pressed plop!"
+    | `Default -> eprintl "default action invoked"
+    | `Closed -> eprintl "notification closed"
+end
diff --git a/examples/ping.ml b/examples/ping.ml
new file mode 100644
index 0000000..d11af8c
--- /dev/null
+++ b/examples/ping.ml
@@ -0,0 +1,38 @@
+(*
+ * ping.ml
+ * -------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Ping the pong service *)
+
+open Lwt
+open Lwt_io
+
+open Ping_pong.Org_foo_bar
+
+let ping proxy msg =
+  OBus_method.call m_Ping proxy msg
+
+let _ = Lwt_main.run begin
+  let%lwt bus = OBus_bus.session () in
+
+  (* Create a proxy for the remote object *)
+  let proxy = OBus_proxy.make (OBus_peer.make bus "org.plop") ["plip"] in
+
+  (* Send a ping *)
+  let%lwt () = printl "trying to ping the pong service..." in
+
+  try%lwt
+    let%lwt msg = ping proxy "coucou" in
+    printlf "received: %s" msg
+  with
+    | OBus_bus.Name_has_no_owner msg ->
+        let%lwt () = printl "You must run pong to try this sample!" in
+        exit 1
+    | exn ->
+        Lwt.fail exn
+end
diff --git a/examples/ping_pong.xml b/examples/ping_pong.xml
new file mode 100644
index 0000000..eb69bdd
--- /dev/null
+++ b/examples/ping_pong.xml
@@ -0,0 +1,8 @@
+<node>
+  <interface name="org.foo.bar">
+    <method name="Ping">
+      <arg direction="in" type="s"/>
+      <arg direction="out" type="s"/>
+    </method>
+  </interface>
+</node>
diff --git a/examples/pong.ml b/examples/pong.ml
new file mode 100644
index 0000000..debfb99
--- /dev/null
+++ b/examples/pong.ml
@@ -0,0 +1,39 @@
+(*
+ * pong.ml
+ * -------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Very simple service with one object have a ping method *)
+
+open Lwt
+open Lwt_io
+
+let ping obj msg =
+  let%lwt () = printlf "received: %s" msg in
+  return msg
+
+let interface =
+  Ping_pong.Org_foo_bar.make {
+    Ping_pong.Org_foo_bar.m_Ping = (fun obj msg -> ping (OBus_object.get obj) msg);
+  }
+
+let () = Lwt_main.run begin
+  let%lwt bus = OBus_bus.session () in
+
+  (* Request a name *)
+  let%lwt _ = OBus_bus.request_name bus "org.plop" in
+
+  (* Create the object *)
+  let obj = OBus_object.make ~interfaces:[interface] ["plip"] in
+  OBus_object.attach obj ();
+
+  (* Export the object on the connection *)
+  OBus_object.export bus obj;
+
+  (* Wait forever *)
+  fst (wait ())
+end
diff --git a/examples/signals.ml b/examples/signals.ml
new file mode 100644
index 0000000..74ff47d
--- /dev/null
+++ b/examples/signals.ml
@@ -0,0 +1,83 @@
+(*
+ * signals.ml
+ * ----------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* This sample illustrate the use of signals *)
+
+open Lwt_react
+open Lwt
+open Lwt_io
+
+(* Add an handler on keyboard event which print the multimedia key
+   pressed *)
+let handle_multimedia_keys device =
+  OBus_signal.connect (Hal_device.condition device)
+  >|= (E.map_p
+         (fun (action, key) ->
+            let%lwt () = printlf "from Hal: action %S on key %S!" action key in
+            let%lwt () = printlf "          the signal come from the device %S" (OBus_path.to_string (Hal_device.udi device)) in
+            return ()))
+  >|= E.keep
+
+let () = Lwt_main.run begin
+  let%lwt session = OBus_bus.session () in
+
+  (* +---------------------------------------------------------------+
+     | Signals from message bus                                      |
+     +---------------------------------------------------------------+ *)
+
+  let%lwt () =
+    OBus_signal.connect (OBus_bus.name_owner_changed session)
+    >|= (E.map_p
+           (fun (name, old_owner, new_owner) ->
+              printlf "from D-Bus: the owner of the name %S changed: %S -> %S"
+                name old_owner new_owner))
+    >|= E.keep
+  in
+
+  let%lwt () =
+    OBus_signal.connect (OBus_bus.name_lost session)
+    >|= E.map_p (printlf "from D-Bus: i lost the name %S!")
+    >|= E.keep
+  in
+
+  let%lwt () =
+    OBus_signal.connect (OBus_bus.name_acquired session)
+    >|= E.map_p (printf "from D-Bus: i got the name '%S!")
+    >|= E.keep
+  in
+
+  (* +---------------------------------------------------------------+
+     | Some Hal signals                                              |
+     +---------------------------------------------------------------+ *)
+
+  let%lwt manager = Hal_manager.manager () in
+
+  let%lwt () =
+    OBus_signal.connect (Hal_manager.device_added manager)
+    >|= (E.map_p
+           (fun device ->
+              let%lwt () = printlf "from Hal: device added: %S" (OBus_path.to_string (Hal_device.udi device)) in
+
+              (* Handle the adding of keyboards *)
+              Hal_device.query_capability device "input.keyboard" >>= function
+                | true -> handle_multimedia_keys device
+                | false -> return ()))
+    >|= E.keep
+  in
+
+  (* Find all keyboards and handle events on them *)
+  let%lwt keyboards = Hal_manager.find_device_by_capability manager "input.keyboard" in
+  let%lwt () = printlf "keyboard founds: %d" (List.length keyboards) in
+  let%lwt () = Lwt_list.iter_p (fun dev -> printlf "  %s" (OBus_path.to_string (Hal_device.udi dev))) keyboards in
+
+  let%lwt () = Lwt_list.iter_p handle_multimedia_keys keyboards in
+
+  let%lwt () = printf "type Ctrl+C to stop\n%!" in
+  fst (wait ())
+end
diff --git a/obus.opam b/obus.opam
new file mode 100644
index 0000000..85a5095
--- /dev/null
+++ b/obus.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+
+name: "obus"
+synopsis: "Pure Ocaml implementation of the D-Bus protocol"
+maintainer: "freyrnjordrson@gmail.com"
+authors: [ "Jérémie Dimino" ]
+homepage: "https://github.com/ocaml-community/obus"
+bug-reports: "https://github.com/ocaml-community/obus/issues"
+dev-repo: "git+https://github.com/ocaml-community/obus.git"
+license: "BSD3"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "dune" {>= "1.1"}
+  "menhir" {build}
+  "xmlm"
+  "lwt" {>= "4.3.0"}
+  "lwt_ppx"
+  "lwt_log"
+  "lwt_react"
+  "ppxlib"
+]
diff --git a/src/idl/dune b/src/idl/dune
new file mode 100644
index 0000000..eae7d2c
--- /dev/null
+++ b/src/idl/dune
@@ -0,0 +1,10 @@
+(library
+  (name OBus_idl)
+  (synopsis "DSL for defining D-Bus interfaces")
+  (libraries obus_internals))
+
+(ocamllex
+  (modules lexer))
+
+(menhir
+  (modules parser))
diff --git a/src/idl/lexer.mll b/src/idl/lexer.mll
new file mode 100644
index 0000000..89791f0
--- /dev/null
+++ b/src/idl/lexer.mll
@@ -0,0 +1,69 @@
+{
+  open Lexing
+  open Parser
+
+  exception SyntaxError of string
+
+}
+
+let lident = ['a'-'z']['a'-'z''0'-'9''_']*
+
+let uident = ['A'-'Z']['a'-'z''A'-'Z''0'-'9''_']*
+
+let integer = ('0'['b''o''x''u'])?['0'-'9']+
+  
+rule read =
+  parse
+  | [' ' '\t' '\n']+ { read lexbuf }
+  | "interface" { INTERFACE }
+  | "method" { METHOD }
+  | "signal" { SIGNAL }
+  | "property_r" { PROPERTY_R }
+  | "property_w" { PROPERTY_W }
+  | "property_rw" { PROPERTY_RW }
+  | "annotation" { ANNOTATION }
+  | "enum" { ENUM }
+  | "flag" { FLAG }
+  | "with" { WITH }
+  | '"' { read_string (Buffer.create 20) lexbuf }
+  | "(*" { skip_comment lexbuf }
+  | "," { COMMA }
+  | "." { PERIOD }
+  | "=" { EQMARK }
+  | ":" { COLON }
+  | "+" { PLUS }
+  | "-" { MINUS }
+  | "*" { STAR }
+  | "->" { ARROW }
+  | "_" { UNDERSCORE }
+  | "{" { LBRACE }
+  | "}" { RBRACE }
+  | "(" { LPAREN }
+  | ")" { RPAREN }
+  | integer as i { INT i }
+  | lident as s { LIDENT s }
+  | uident as s { UIDENT s }
+  | _ { raise (SyntaxError ("Unexpected char: " ^ Lexing.lexeme lexbuf)) }
+  | eof { EOF }
+
+and skip_comment =
+  parse
+  | "*)" { read lexbuf }
+  | _ { skip_comment lexbuf }
+
+and read_string buf =
+  parse
+  | '"'       { STRING (Buffer.contents buf) }
+  | '\\' '/'  { Buffer.add_char buf '/'; read_string buf lexbuf }
+  | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf }
+  | '\\' 'b'  { Buffer.add_char buf '\b'; read_string buf lexbuf }
+  | '\\' 'f'  { Buffer.add_char buf '\012'; read_string buf lexbuf }
+  | '\\' 'n'  { Buffer.add_char buf '\n'; read_string buf lexbuf }
+  | '\\' 'r'  { Buffer.add_char buf '\r'; read_string buf lexbuf }
+  | '\\' 't'  { Buffer.add_char buf '\t'; read_string buf lexbuf }
+  | [^ '"' '\\']+
+    { Buffer.add_string buf (Lexing.lexeme lexbuf);
+      read_string buf lexbuf
+    }
+  | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) }
+  | eof { raise (SyntaxError ("String is not terminated")) }
diff --git a/src/idl/oBus_idl.ml b/src/idl/oBus_idl.ml
new file mode 100644
index 0000000..6ccbe8d
--- /dev/null
+++ b/src/idl/oBus_idl.ml
@@ -0,0 +1,159 @@
+open Lexer
+open Lexing
+   
+exception Parse_failure of string
+
+let parse s =
+  let lexbuf = Lexing.from_string s in
+  try
+    Parser.interfaces Lexer.read lexbuf
+  with e ->
+    let curr = lexbuf.Lexing.lex_curr_p in
+    let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
+    let tok = Lexing.lexeme lexbuf in
+    raise (Parse_failure (Printf.sprintf "%s: pos [%d] token %s"
+                            (Printexc.to_string e)
+                            cnum
+                            tok))
+
+let parse_file file_name =
+  let ic = open_in file_name in
+  let lexbuf = Lexing.from_channel ic in
+  try
+    let ifaces = Parser.interfaces Lexer.read lexbuf in
+    close_in ic;
+    ifaces
+  with e ->
+    close_in ic;
+    let curr = lexbuf.Lexing.lex_curr_p in
+    let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
+    let tok = Lexing.lexeme lexbuf in
+    raise (Parse_failure (Printf.sprintf "%s: pos [%d] token %s"
+                            (Printexc.to_string e)
+                            cnum
+                            tok))
+
+(* +-----------------------------------------------------------------+
+   | Printing                                                        |
+   +-----------------------------------------------------------------+ *)
+
+open OBus_introspect_ext
+open OBus_value
+open Format
+
+let rec print_term top pp = function
+  | Term(id, []) -> pp_print_string pp id
+  | Term(id, [t]) -> fprintf pp "%a %s" (print_term false) t id
+  | Term(id, tl) -> fprintf pp "(%a) %s" (print_seq true ", ") tl id
+  | Tuple tl -> if top then print_seq false " * " pp tl else fprintf pp "(%a)" (print_seq false " * ") tl
+
+and print_seq top sep pp = function
+  | [] -> ()
+  | [t] -> print_term top pp t
+  | t :: tl -> fprintf pp "%a%s%a" (print_term top) t sep (print_seq top sep) tl
+
+let print_args pp args =
+  let rec aux = function
+    | [] ->
+        ()
+    | [(None, typ)] ->
+        fprintf pp "_ : %a" (print_term true) typ
+    | [(Some name, typ)] ->
+        fprintf pp "%s : %a" name (print_term true) typ
+    | (None, typ) :: l ->
+        fprintf pp "_ : %a, " (print_term true) typ;
+        aux l
+    | (Some name, typ) :: l ->
+        fprintf pp "%s : %a, " name (print_term true) typ;
+        aux l
+  in
+  pp_print_char pp '(';
+  aux args;
+  pp_print_char pp ')'
+
+let print_annotations pp = function
+  | [] ->
+      ()
+  | l ->
+      pp_print_string pp "    with {\n";
+      List.iter (fun (name, value) -> fprintf pp "      %s = %S\n" name value) l;
+      pp_print_string pp "    }\n"
+
+let string_of_key = function
+  | T.Byte -> "byte"
+  | T.Int16 -> "int16"
+  | T.Int32 -> "int32"
+  | T.Int64 -> "int64"
+  | T.Uint16 -> "uint16"
+  | T.Uint32 -> "uint32"
+  | T.Uint64 -> "uint64"
+  | _ -> assert false
+
+let print pp interfaces =
+  List.iter
+    (function (name, members, symbols, annotations) ->
+       fprintf pp "\ninterface %s {\n" name;
+       List.iter
+         (fun (name, sym) ->
+            let keyword, typ, values =
+              match sym with
+                | Sym_enum(typ, values) -> "enum", typ, values
+                | Sym_flag(typ, values) -> "flag", typ, values
+            in
+            fprintf pp "  %s %s : %s {\n" keyword name (string_of_key typ);
+            let values =
+              List.map
+                (fun (key, name) ->
+                   ((match key with
+                       | V.Byte x ->
+                           sprintf "%x" (Char.code x)
+                       | V.Int16 x | V.Uint16 x ->
+                           sprintf "%x" x
+                       | V.Int32 x | V.Uint32 x ->
+                           sprintf "%lx" x
+                       | V.Int64 x | V.Uint64 x ->
+                           sprintf "%Lx" x
+                       | _ ->
+                           assert false),
+                    name))
+                values
+            in
+            let max_len = List.fold_left (fun m (key, name) -> max m (String.length key)) 0 values in
+            List.iter
+              (fun (key, name) ->
+                 fprintf pp "    0x%s%s: %s\n" (String.make (max_len - String.length key) '0') key name)
+              values;
+            fprintf pp "  }\n")
+         symbols;
+       List.iter (fun (name, value) -> fprintf pp "  annotation %s = %S\n" name value) annotations;
+       List.iter
+         (function
+            | Method(name, i_args, o_args, annotations) ->
+                fprintf pp "  method %s : %a -> %a\n" name print_args i_args print_args o_args;
+                print_annotations pp annotations
+            | Signal(name, args, annotations) ->
+                fprintf pp "  signal %s : %a\n" name print_args args;
+                print_annotations pp annotations
+            | Property(name, typ, access, annotations) ->
+                fprintf pp "  property.%s %s : %a\n"
+                  (match access with
+                     | Read -> "r"
+                     | Write -> "w"
+                     | Read_write -> "rw")
+                  name (print_term true) typ;
+                print_annotations pp annotations)
+         members;
+       pp_print_string pp "}\n")
+    interfaces
+
+let print_file name interfaces =
+  let oc = open_out name in
+  let pp = formatter_of_out_channel oc in
+  try
+    print pp interfaces;
+    pp_print_flush pp ();
+    close_out oc
+  with exn ->
+    (* Should never happen *)
+    close_out oc;
+    raise exn
diff --git a/src/idl/oBus_idl.mli b/src/idl/oBus_idl.mli
new file mode 100644
index 0000000..825be66
--- /dev/null
+++ b/src/idl/oBus_idl.mli
@@ -0,0 +1,27 @@
+(*
+ * oBus_idl.mli
+ * ------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Intermediate language for writing D-Bus interfaces *)
+
+exception Parse_failure of string
+  (** Exception raised when parsing fails for some reason. The
+      argument is an error message. *)
+
+val parse : string -> OBus_introspect_ext.interface list
+  (** [parse string] parses the given string. *)
+
+val parse_file : string -> OBus_introspect_ext.interface list
+  (** [parse_file path] Helper to parse the contents of a file. *)
+
+val print : Format.formatter -> OBus_introspect_ext.interface list -> unit
+  (** [print pp interfaces] prints the given interfaces on [pp] in the
+      obus idl format *)
+
+val print_file : string -> OBus_introspect_ext.interface list -> unit
+  (** Helper to print to a file *)
diff --git a/src/idl/parser.mly b/src/idl/parser.mly
new file mode 100644
index 0000000..fd28695
--- /dev/null
+++ b/src/idl/parser.mly
@@ -0,0 +1,181 @@
+%{
+    open OBus_value
+    open OBus_introspect_ext
+
+    let rec get_members = function
+      | [] -> []
+      | `Member m :: rest -> m :: get_members rest
+      | `Annotation _ :: rest -> get_members rest
+      | `Symbol _ :: rest -> get_members rest
+
+    let rec get_annotations = function
+      | [] -> []
+      | `Member _ :: rest -> get_annotations rest
+      | `Annotation a :: rest -> a :: get_annotations rest
+      | `Symbol _ :: rest ->  get_annotations rest
+    
+    let rec get_symbols = function
+      | [] -> []
+      | `Member _ :: rest -> get_symbols rest
+      | `Annotation _ :: rest -> get_symbols rest
+      | `Symbol s :: rest -> s :: get_symbols rest
+
+    let parse_int typ str =
+      match typ with
+      | T.Byte -> V.Byte(char_of_int (int_of_string str))
+      | T.Int16 -> V.Int16(int_of_string str)
+      | T.Int32 -> V.Int32(Int32.of_string str)
+      | T.Int64 -> V.Int64(Int64.of_string str)
+      | T.Uint16 -> V.Uint16(int_of_string str)
+      | T.Uint32 -> V.Uint32(Int32.of_string str)
+      | T.Uint64 -> V.Uint64(Int64.of_string str)
+      | _ -> assert false
+
+    let rev = List.rev
+%}
+
+%token INTERFACE METHOD SIGNAL PROPERTY_R PROPERTY_W PROPERTY_RW
+%token ANNOTATION ENUM FLAG WITH
+%token COMMA PERIOD LBRACE RBRACE LPAREN RPAREN
+%token EQMARK COLON PLUS MINUS ARROW UNDERSCORE STAR
+%token<string> LIDENT UIDENT
+%token<string> STRING
+%token<string> INT
+%token EOF
+
+%start <OBus_introspect_ext.interface list> interfaces
+
+%%
+
+interfaces:
+  | EOF { [] }
+  | iface = interface; ifaces = interfaces
+    { iface :: ifaces }
+;
+
+interface:
+  | INTERFACE; name = name; LBRACE; members = members; RBRACE
+    { (name, get_members members, get_symbols members, get_annotations members) }
+;
+
+ident:
+  | n = LIDENT { n }
+  | n = UIDENT { n }
+;
+
+name:
+  | n = ident { n }
+  | n = ident; PERIOD; rest = name
+    { n ^ "." ^ rest }
+;
+
+members:
+  | { [] }
+  | members = members; member = member
+    { member :: members }
+;
+
+member:
+  | METHOD; name = ident; COLON; LPAREN; i_args = arguments; RPAREN; ARROW; LPAREN; o_args = arguments; RPAREN; annot = annotations
+    { `Member (Method (name, i_args, o_args, annot)) }
+  | SIGNAL; name = ident; COLON; LPAREN; args = arguments; RPAREN; annot = annotations
+    { `Member (Signal (name, args, annot)) }
+  | PROPERTY_R; name = ident; COLON; typ = type_term; annot = annotations
+    { `Member (Property (name, typ, Read, annot)) }
+  | PROPERTY_W; name = ident; COLON; typ = type_term; annot = annotations
+    { `Member (Property (name, typ, Write, annot)) }
+  | PROPERTY_RW; name = ident; COLON; typ = type_term; annot = annotations
+    { `Member (Property (name, typ, Read_write, annot)) }
+  | ANNOTATION; name = STRING; EQMARK; value = STRING
+    { `Annotation (name, value) }
+  | ENUM; name = ident; COLON; typ = key_type; LBRACE; values = values; RBRACE
+    { `Symbol (name,
+               sym_enum typ (List.map (fun (key, value) ->
+                                        (parse_int typ key, value)) values)) }
+  | FLAG; name = ident; COLON; typ = key_type; LBRACE; values = values; RBRACE
+    { `Symbol (name,
+               sym_flag typ (List.map (fun (key, value) ->
+                                        (parse_int typ key, value)) values)) }
+;
+
+values:
+  | { [] }
+  | vals = values; v = value
+    { v :: vals }
+;
+
+value:
+  | key = INT; COLON; value = ident
+    { (key, value) }
+  | MINUS; key = INT; COLON; value = ident
+    { ("-" ^ key, value) }
+  | PLUS; key = INT; COLON; value = ident
+    { (key, value) }
+;
+
+annotations:
+  | { [] }
+  | WITH; LBRACE; annots = annotations; last = annotation; RBRACE
+    { last :: annots }
+;
+
+annotation:
+  | name = name; EQMARK; value = STRING
+    { (name, value) }
+;
+
+arguments:
+  | { [] }
+  | arg = argument
+    { [ arg ] }
+  | arg = argument; COMMA; rest = arguments
+    { arg :: rest }
+;
+
+argument:
+  | name = ident; COLON; typ = type_term
+    { (Some name, typ) }
+  | UNDERSCORE; COLON; typ = type_term
+    { (None, typ) }
+;
+
+type_term:
+  | id = ident
+    { term id [] }
+  | LPAREN; t = type_term; RPAREN
+    { t }
+  | LPAREN; tup = type_tuple; RPAREN
+    { tuple tup }
+  | t = type_term; id = ident
+    { term id [t] }
+  | LPAREN; args = type_args; RPAREN; id = ident
+    { term id args }
+;
+
+type_tuple:
+  | t = type_term; STAR; tl = type_tuple
+    { t :: tl }
+  | t = type_term
+    { [ t ] }
+;
+
+type_args:
+  | t = type_term; COMMA; tl = type_args
+    { t :: tl }
+  | t = type_term
+    { [ t ] }
+;
+
+key_type:
+  | id = LIDENT
+    { match id with
+      | "byte" -> T.Byte
+      | "int16" -> T.Int16
+      | "int32" -> T.Int32
+      | "int64" -> T.Int64
+      | "uint16" -> T.Uint16
+      | "uint32" -> T.Uint32
+      | "uint64" -> T.Uint64
+      | _ -> raise (Failure(Printf.sprintf "invalid key type: %s" id))
+    }
+;
diff --git a/src/internals/dune b/src/internals/dune
new file mode 100644
index 0000000..da5a900
--- /dev/null
+++ b/src/internals/dune
@@ -0,0 +1,8 @@
+(library
+ (name obus_internals)
+ (public_name obus.internals)
+ (libraries lwt.unix lwt_log xmlm)
+ (wrapped false)
+ (preprocess (pps lwt_ppx)))
+
+(ocamllex oBus_type_ext_lexer)
diff --git a/src/internals/oBus_introspect.ml b/src/internals/oBus_introspect.ml
new file mode 100644
index 0000000..35a7bfa
--- /dev/null
+++ b/src/internals/oBus_introspect.ml
@@ -0,0 +1,188 @@
+(*
+ * oBus_introspect.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 OBus_xml_parser
+
+type name = string
+
+type annotation = name * string
+type argument = name option * OBus_value.T.single
+
+type access = Read | Write | Read_write
+
+type member =
+  | Method of name * argument list * argument list * annotation list
+  | Signal of name * argument list * annotation list
+  | Property of name * OBus_value.T.single * access * annotation list
+
+type interface = name * member list * annotation list
+type node = OBus_path.element
+type document = interface list * node list
+
+exception Parse_failure = OBus_xml_parser.Parse_failure
+
+let () =
+  Printexc.register_printer
+    (function
+       | Parse_failure((line, column), msg) ->
+           Some(Printf.sprintf "failed to parse D-Bus introspection document, at line %d, column %d: %s" line column msg)
+       | _ ->
+           None)
+
+let annotations p =
+  any p (elt "annotation"
+           (fun p ->
+              let name = ar p "name" in
+              let value = ar p "value" in
+              (name, value)))
+
+type direction = In | Out
+
+let atype p =
+  let signature = ar p "type" in
+  match OBus_value.signature_of_string signature with
+    | [] -> failwith p "empty signature"
+    | [t] -> t
+    | _ -> Printf.ksprintf (failwith p) "this signature contains more than one single type: %S" signature
+
+let arguments p =
+  any p (elt "arg"
+           (fun p ->
+              let name = ao p "name" in
+              let dir = afd p "direction" In [("in", In); ("out", Out)] in
+              let typ = atype p in
+              (dir, (name, typ))))
+
+let mk_aname test p =
+  let name = ar p "name" in
+  match test name with
+    | Some error -> failwith p (OBus_string.error_message error)
+    | None -> name
+
+let amember = mk_aname OBus_name.validate_member
+let anode = mk_aname OBus_path.validate_element
+let ainterface = mk_aname OBus_name.validate_interface
+
+let method_decl =
+  elt "method"
+    (fun p ->
+       let name = amember p in
+       let args = arguments p in
+       let ins, outs =
+         OBus_util.split
+           (function
+              | (In, x) -> OBus_util.InL x
+              | (Out, x) -> OBus_util.InR x)
+           args
+       in
+       let annots = annotations p in
+       (Method(name, ins, outs, annots)))
+
+let signal_decl =
+  elt "signal"
+    (fun p ->
+       let name = amember p in
+       let args = arguments p in
+       let annots = annotations p in
+       (Signal(name, List.map snd args, annots)))
+
+let property_decl =
+  elt "property"
+    (fun p ->
+       let name = amember p in
+       let access = afr p "access" [("read", Read); ("write", Write); ("readwrite", Read_write)] in
+       let typ = atype p in
+       let annots = annotations p in
+       (Property(name, typ, access, annots)))
+
+let node =
+  elt "node" (fun p ->
+                let name = anode p in
+                match OBus_path.validate_element name with
+                  | None -> name
+                  | Some error -> failwith p (OBus_string.error_message { error with OBus_string.typ = "node name" }))
+
+let interface =
+  elt "interface"
+    (fun p ->
+       let name = ainterface p in
+       let decls = any p (union [method_decl;
+                                 signal_decl;
+                                 property_decl]) in
+       let annots = annotations p in
+       (name, decls, annots))
+
+let document =
+  elt "node"
+    (fun p ->
+       let interfs = any p interface in
+       let subs = any p node in
+       (interfs, subs))
+
+let input xi = OBus_xml_parser.input xi document
+
+type xml = Element of string * (string * string) list * xml list
+
+let to_xml (ifaces, nodes) =
+  let pannots = List.map (fun (n, v) -> Element("annotation", [("name", n); ("value", v)], [])) in
+  let pargs dir = List.map (fun (n, t) ->
+                             let attrs = [("type", OBus_value.string_of_signature [t])] in
+                             let attrs = match dir with
+                               | Some In -> ("direction", "in") :: attrs
+                               | Some Out -> ("direction", "out") :: attrs
+                               | None -> attrs in
+                             let attrs = match n with
+                               | Some n -> ("name", n) :: attrs
+                               | None -> attrs in
+                             Element("arg", attrs, [])) in
+  Element("node", [],
+          List.map (fun (name, content, annots) ->
+                      Element("interface", [("name", name)],
+                              pannots annots
+                              @ List.map
+                                (function
+                                   | Method(name, ins, outs, annots) ->
+                                       Element("method", [("name", name)],
+                                               pargs (Some In) ins
+                                               @ pargs (Some Out) outs
+                                               @ pannots annots)
+                                   | Signal(name, args, annots) ->
+                                       Element("signal", [("name", name)],
+                                               pargs None args
+                                               @ pannots annots)
+                                   | Property(name, typ, access, annots) ->
+                                       Element("property",
+                                               [("name", name);
+                                                ("type", OBus_value.string_of_signature [typ]);
+                                                ("access", match access with
+                                                   | Read -> "read"
+                                                   | Write -> "write"
+                                                   | Read_write -> "readwrite")],
+                                               pannots annots))
+                                content)) ifaces
+          @ List.map (fun n -> Element("node", [("name", n)], [])) nodes)
+
+let output xo doc =
+  let rec aux (Element(name, attrs, children)) =
+    Xmlm.output xo (`El_start(("", name), List.map (fun (name, value) -> (("", name), value)) attrs));
+    List.iter aux children;
+    Xmlm.output xo `El_end
+  in
+  Xmlm.output xo (`Dtd(Some "<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\"\n\
+                             \"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">"));
+  aux (to_xml doc)
+
+(* +-----------------------------------------------------------------+
+   | Annotations                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let deprecated = "org.freedesktop.DBus.Deprecated"
+let csymbol = "org.freedesktop.DBus.GLib.CSymbol"
+let no_reply = "org.freedesktop.DBus.Method.NoReply"
+let emits_changed_signal = "org.freedesktop.DBus.Property.EmitsChangedSignal"
diff --git a/src/internals/oBus_introspect.mli b/src/internals/oBus_introspect.mli
new file mode 100644
index 0000000..983d6ae
--- /dev/null
+++ b/src/internals/oBus_introspect.mli
@@ -0,0 +1,54 @@
+(*
+ * oBus_introspect.mli
+ * -------------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus obejct introspection *)
+
+type name = string
+
+type annotation = name * string
+type argument = name option * OBus_value.T.single
+
+type access = Read | Write | Read_write
+    (** Access mode of properties *)
+
+type member =
+  | Method of name * argument list * argument list * annotation list
+  | Signal of name * argument list * annotation list
+  | Property of name * OBus_value.T.single * access * annotation list
+
+type interface = name * member list * annotation list
+type node = OBus_path.element
+
+type document = interface list * node list
+
+(** {6 Xml conversion} *)
+
+exception Parse_failure of Xmlm.pos * string
+
+val input : Xmlm.input -> document
+  (** Try to read an xml document as an introspection document.
+
+      @raise Parse_failure if the parsing fail. *)
+
+val output : Xmlm.output -> document -> unit
+  (** Create an xml from an introspection document *)
+
+(** {6 Well-known annotations} *)
+
+val deprecated : name
+  (** The [org.freedesktop.DBus.Deprecated] annotation *)
+
+val csymbol : name
+  (** The [org.freedesktop.DBus.GLib.CSymbol] annotation *)
+
+val no_reply : name
+  (** The [org.freedesktop.DBus.Method.NoReply] annotation *)
+
+val emits_changed_signal : name
+  (** The [org.freedesktop.DBus.Property.EmitsChangedSignal] annotation *)
diff --git a/src/internals/oBus_introspect_ext.ml b/src/internals/oBus_introspect_ext.ml
new file mode 100644
index 0000000..810fc34
--- /dev/null
+++ b/src/internals/oBus_introspect_ext.ml
@@ -0,0 +1,460 @@
+(*
+ * oBus_introspect_ext.ml
+ * ----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+open OBus_value
+
+(* +-----------------------------------------------------------------+
+   | Annotations                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let obus_enum = "org.ocamlcore.forge.obus.Enum"
+let obus_flag = "org.ocamlcore.forge.obus.Flag"
+let obus_type = "org.ocamlcore.forge.obus.Type"
+let obus_itype = "org.ocamlcore.forge.obus.IType"
+let obus_otype = "org.ocamlcore.forge.obus.OType"
+
+(* +-----------------------------------------------------------------+
+   | Extended types                                                  |
+   +-----------------------------------------------------------------+ *)
+
+type basic =
+  | Byte
+  | Boolean
+  | Int16
+  | Int32
+  | Int64
+  | Uint16
+  | Uint32
+  | Uint64
+  | Double
+  | String
+  | Signature
+  | Object_path
+  | Unix_fd
+  | Enum of T.basic * (V.basic * string) list
+  | Flag of T.basic * (V.basic * string) list
+
+type single =
+  | Basic of basic
+  | Structure of single list
+  | Array of single
+  | Dict of basic * single
+  | Variant
+
+type sequence = single list
+
+let byte = Byte
+let boolean = Boolean
+let int16 = Int16
+let int32 = Int32
+let int64 = Int64
+let uint16 = Uint16
+let uint32 = Uint32
+let uint64 = Uint64
+let double = Double
+let string = String
+let signature = Signature
+let object_path = Object_path
+let unix_fd = Unix_fd
+
+let check_values func typ values =
+  match typ with
+    | T.Byte
+    | T.Int16
+    | T.Int32
+    | T.Int64
+    | T.Uint16
+    | T.Uint32
+    | T.Uint64 ->
+        List.iter
+          (fun (value, name) ->
+             if V.type_of_basic value <> typ then
+               ksprintf invalid_arg "OBus_introspect_ext.%s: unexpected type" func)
+          values
+    | _ ->
+        ksprintf
+          invalid_arg
+          "OBus_introspect_ext.%s: type '%s' is not supported for enumerations"
+          func
+          (T.string_of_basic typ)
+
+let enum typ values =
+  check_values "enum" typ values;
+  Enum(typ, values)
+
+let flag typ values =
+  check_values "flag" typ values;
+  Flag(typ, values)
+
+let basic t = Basic t
+let structure t = Structure t
+let array t = Array t
+let dict tk tv = Dict(tk, tv)
+let variant = Variant
+
+(* +-----------------------------------------------------------------+
+   | Stripping                                                       |
+   +-----------------------------------------------------------------+ *)
+
+let strip_basic = function
+  | Byte -> T.Byte
+  | Boolean -> T.Boolean
+  | Int16 -> T.Int16
+  | Int32 -> T.Int32
+  | Int64 -> T.Int64
+  | Uint16 -> T.Uint16
+  | Uint32 -> T.Uint32
+  | Uint64 -> T.Uint64
+  | Double -> T.Double
+  | String -> T.String
+  | Signature -> T.Signature
+  | Object_path -> T.Object_path
+  | Unix_fd -> T.Unix_fd
+  | Enum(t, _) -> t
+  | Flag(t, _) -> t
+
+let rec strip_single = function
+  | Basic t -> T.Basic(strip_basic t)
+  | Structure tl -> T.structure(List.map strip_single tl)
+  | Array t ->  T.Array(strip_single t)
+  | Dict(tk, tv) -> T.Dict(strip_basic tk, strip_single tv)
+  | Variant -> T.Variant
+
+let strip_sequence l = List.map strip_single l
+
+(* +-----------------------------------------------------------------+
+   | Projections                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let project_basic = function
+  | T.Byte -> Byte
+  | T.Boolean -> Boolean
+  | T.Int16 -> Int16
+  | T.Int32 -> Int32
+  | T.Int64 -> Int64
+  | T.Uint16 -> Uint16
+  | T.Uint32 -> Uint32
+  | T.Uint64 -> Uint64
+  | T.Double -> Double
+  | T.String -> String
+  | T.Signature -> Signature
+  | T.Object_path -> Object_path
+  | T.Unix_fd -> Unix_fd
+
+let rec project_single = function
+  | T.Basic t -> Basic(project_basic t)
+  | T.Structure tl -> structure(List.map project_single tl)
+  | T.Array t -> Array(project_single t)
+  | T.Dict(tk, tv) -> Dict(project_basic tk, project_single tv)
+  | T.Variant -> Variant
+
+let project_sequence l = List.map project_single l
+
+(* +-----------------------------------------------------------------+
+   | Symbols and environments                                        |
+   +-----------------------------------------------------------------+ *)
+
+type term = OBus_type_ext_lexer.term =
+  | Term of string * term list
+  | Tuple of term list
+
+let term name args = Term(name, args)
+let tuple = function
+  | [t] -> t
+  | l -> Tuple l
+
+type symbol =
+  | Sym_enum of OBus_value.T.basic * (OBus_value.V.basic * string) list
+  | Sym_flag of OBus_value.T.basic * (OBus_value.V.basic * string) list
+
+let sym_enum typ values =
+  check_values "sym_enum" typ values;
+  Sym_enum(typ, values)
+
+let sym_flag typ values =
+  check_values "sym_flag" typ values;
+  Sym_flag(typ, values)
+
+type env = (string * symbol) list
+
+exception Resolve_error of string
+
+let rec resolve env = function
+  | Term(name, args) -> begin
+      let args = List.map (resolve env) args in
+      match try Some(List.assoc name env) with Not_found -> None with
+        | Some(Sym_enum(typ, values)) ->
+            Basic(Enum(typ, values))
+        | Some(Sym_flag(typ, values)) ->
+            Basic(Flag(typ, values))
+        | None ->
+            match name, args with
+              | "byte", [] -> Basic Byte
+              | "boolean", [] -> Basic Boolean
+              | "int16", [] -> Basic Int16
+              | "int32", [] -> Basic Int32
+              | "int64", [] -> Basic Int64
+              | "uint16", [] -> Basic Uint16
+              | "uint32", [] -> Basic Uint32
+              | "uint64", [] -> Basic Uint64
+              | "double", [] -> Basic Double
+              | "string", [] -> Basic String
+              | "signature", [] -> Basic Signature
+              | "object_path", [] -> Basic Object_path
+              | "unix_fd", [] -> Basic Unix_fd
+              | "array", [t] -> Array t
+              | "dict", [Basic tk; tv] -> Dict(tk, tv)
+              | "dict", [tk; tv] -> raise (Resolve_error "type of a dictionary key must be a basic type")
+              | "variant", [] -> Variant
+              | _ -> raise (Resolve_error(sprintf "unbounded symbol: %S with arity %d" name (List.length args)))
+    end
+  | Tuple l ->
+      Structure(List.map (resolve env) l)
+
+(* +-----------------------------------------------------------------+
+   | Projection D-Bus types -> terms                                 |
+   +-----------------------------------------------------------------+ *)
+
+let term_of_basic = function
+  | T.Byte -> term "byte" []
+  | T.Boolean -> term "boolean" []
+  | T.Int16 -> term "int16" []
+  | T.Int32 -> term "int32" []
+  | T.Int64 -> term "int64" []
+  | T.Uint16 -> term "uint16" []
+  | T.Uint32 -> term "uint32" []
+  | T.Uint64 -> term "uint64" []
+  | T.Double -> term "double" []
+  | T.String -> term "string" []
+  | T.Signature -> term "signature" []
+  | T.Object_path -> term "object_path" []
+  | T.Unix_fd -> term "unix_fd" []
+
+let rec term_of_single = function
+  | T.Basic t -> term_of_basic t
+  | T.Array t -> term "array" [term_of_single t]
+  | T.Dict(tk, tv) -> term "dict" [term_of_basic tk; term_of_single tv]
+  | T.Structure tl -> tuple (List.map term_of_single tl)
+  | T.Variant -> term "variant" []
+
+let term_of_sequence l = tuple (List.map term_of_single l)
+
+(* +-----------------------------------------------------------------+
+   | Exended ast                                                     |
+   +-----------------------------------------------------------------+ *)
+
+type name = string
+
+type annotation = name * string
+type argument = name option * term
+
+type access = OBus_introspect.access = Read | Write | Read_write
+
+type member =
+  | Method of name * argument list * argument list * annotation list
+  | Signal of name * argument list * annotation list
+  | Property of name * term * access * annotation list
+
+type interface = name * member list * (string * symbol) list * annotation list
+
+(* +-----------------------------------------------------------------+
+   | Printing/parsing                                                |
+   +-----------------------------------------------------------------+ *)
+
+open Printf
+
+let rec string_of_term = function
+  | Term(name, []) ->
+      name
+  | Term(name, args) ->
+      "(" ^ String.concat " " (name :: List.map string_of_term args) ^ ")"
+  | Tuple typs ->
+      "<" ^ String.concat "," (List.map string_of_term typs) ^ ">"
+
+let string_of_enum name typ values =
+  sprintf "%s:%s=%s"
+    name
+    (match typ with
+       | T.Byte -> "byte"
+       | T.Int16 -> "int16"
+       | T.Int32 -> "int32"
+       | T.Int64 -> "int64"
+       | T.Uint16 -> "uint16"
+       | T.Uint32 -> "uint32"
+       | T.Uint64 -> "uint64"
+       | _ -> assert false)
+    (String.concat ","
+       (List.map
+          (fun (key, value) ->
+             sprintf "%s:%s"
+               (match key with
+                  | V.Byte x ->
+                      string_of_int (Char.code x)
+                  | V.Int16 x | V.Uint16 x ->
+                      string_of_int x
+                  | V.Int32 x | V.Uint32 x ->
+                      Int32.to_string x
+                  | V.Int64 x | V.Uint64 x ->
+                      Int64.to_string x
+                  | _ ->
+                      assert false)
+               value)
+          values))
+
+let string_of_flag = string_of_enum
+
+let term_of_string str =
+  try
+    OBus_type_ext_lexer.single (Lexing.from_string str)
+  with OBus_type_ext_lexer.Fail(pos, msg) ->
+    ksprintf failwith "failed to parse extended type %S, at position %d: %s" str pos msg
+
+let enum_of_string str =
+  try
+    OBus_type_ext_lexer.enum_and_flag (Lexing.from_string str)
+  with OBus_type_ext_lexer.Fail(pos, msg) ->
+    ksprintf failwith "failed to parse extended symbol %S, at position %d: %s" str pos msg
+
+let flag_of_string = enum_of_string
+
+(* +-----------------------------------------------------------------+
+   | Encoding                                                        |
+   +-----------------------------------------------------------------+ *)
+
+let set_annotation name value annotations =
+  let rec loop acc = function
+    | [] ->  (name, value) :: acc
+    | (name', _) :: rest when name = name' -> (name, value) :: List.rev_append acc rest
+    | a :: rest -> loop (a :: acc) rest
+  in
+  loop [] annotations
+
+let encode_arguments env args annotation_name annotations =
+  let rec loop acc use_ext = function
+    | [] ->
+        (List.rev acc, use_ext)
+    | (name, typ) :: rest ->
+        let ext_typ = resolve env typ in
+        let std_typ = strip_single ext_typ in
+        (* Check whether the type contains extended types: *)
+        if project_single std_typ = ext_typ then
+          loop ((name, std_typ) :: acc) use_ext rest
+        else
+          loop ((name, std_typ) :: acc) true rest
+  in
+  let args', use_ext = loop [] false args in
+  if use_ext then
+    (args',
+     set_annotation annotation_name
+       (string_of_term
+          (tuple
+             (List.map snd args)))
+       annotations)
+  else
+    (args', annotations)
+
+let encode (name, members, symbols, annotations) =
+  let env = symbols in
+  let members =
+    List.map
+      (function
+         | Method(name, i_args, o_args, annotations) ->
+             let i_args, annotations = encode_arguments env i_args obus_itype annotations in
+             let o_args, annotations = encode_arguments env o_args obus_otype annotations in
+             OBus_introspect.Method(name, i_args, o_args, annotations)
+         | Signal(name, args, annotations) ->
+             let args, annotations = encode_arguments env args obus_type annotations in
+             OBus_introspect.Signal(name, args, annotations)
+         | Property(name, typ, access, annotations) -> begin
+             match encode_arguments env [(None, typ)] obus_type annotations with
+               | [(None, typ)], annotations ->
+                   OBus_introspect.Property(name, typ, access, annotations)
+               | _ ->
+                   assert false
+           end)
+      members
+  in
+  let annotations =
+    List.map
+      (function
+         | (name, Sym_enum(typ, values)) ->
+             (obus_enum, string_of_enum name typ values)
+         | (name, Sym_flag(typ, values)) ->
+             (obus_flag, string_of_flag name typ values))
+      symbols
+    @ annotations
+  in
+  (name, members, annotations)
+
+let get_annotation name annotations =
+  let rec loop acc = function
+    | [] ->
+        (acc, None)
+    | (name', value) :: rest ->
+        if name = name' then
+          (List.rev_append acc rest, Some value)
+        else
+          loop ((name', value) :: acc) rest
+  in
+  loop [] annotations
+
+let decode_arguments args annotation_name annotations =
+  match get_annotation annotation_name annotations with
+    | (annotations, None) ->
+        (List.map (fun (name, typ) -> (name, term_of_single typ)) args,
+         annotations)
+    | (annotations, Some value) ->
+        (List.map2
+           (fun (name, _) term -> (name, term))
+           args
+           (match term_of_string value with
+              | Tuple l -> l
+              | t -> [t]),
+         annotations)
+
+let decode (name, members, annotations) =
+  let members =
+    List.map
+      (function
+         | OBus_introspect.Method(name, i_args, o_args, annotations) ->
+             let i_args, annotations = decode_arguments i_args obus_itype annotations in
+             let o_args, annotations = decode_arguments o_args obus_otype annotations in
+             Method(name, i_args, o_args, annotations)
+         | OBus_introspect.Signal(name, args, annotations) ->
+             let args, annotations = decode_arguments args obus_type annotations in
+             Signal(name, args, annotations)
+         | OBus_introspect.Property(name, typ, access, annotations) -> begin
+             match decode_arguments [(None, typ)] obus_type annotations with
+               | [(None, typ)], annotations ->
+                   Property(name, typ, access, annotations)
+               | _ ->
+                   assert false
+           end)
+      members
+  in
+  let symbols, annotations =
+    List.partition
+      (fun (name, value) -> name = obus_enum || name = obus_flag)
+      annotations
+  in
+  let symbols =
+    List.map
+      (fun (name, value) ->
+         if name = obus_enum then
+           let name, typ, values = enum_of_string value in
+           (name, sym_enum typ values)
+         else if name = obus_flag then
+           let name, typ, values = flag_of_string value in
+           (name, sym_flag typ values)
+         else
+           assert false)
+      symbols
+  in
+  (name, members, symbols, annotations)
diff --git a/src/internals/oBus_introspect_ext.mli b/src/internals/oBus_introspect_ext.mli
new file mode 100644
index 0000000..6ab877e
--- /dev/null
+++ b/src/internals/oBus_introspect_ext.mli
@@ -0,0 +1,226 @@
+(*
+ * oBus_introspect_ext.mli
+ * -----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** OBus extended introspection *)
+
+(** By default, introspection documents do not convey semantical
+    information, such as enumerations or flags. However it is possible
+    to attach information to interfaces and members.
+
+    This module implements an extended introspection format, which can
+    be encoded into standard introspection documents by using
+    annotations.
+*)
+
+(** {6 Annotations} *)
+
+(** The following annotations are used to encode additional
+    informations into D-Bus introspection documents *)
+
+val obus_enum : string
+  (** The [org.ocamlcore.forge.obus.Enum] annotation *)
+
+val obus_flag : string
+  (** The [org.ocamlcore.forge.obus.Flag] annotation *)
+
+val obus_type : string
+  (** The [org.ocamlcore.forge.obus.Type] annotation *)
+
+val obus_itype : string
+  (** The [org.ocamlcore.forge.obus.IType] annotation *)
+
+val obus_otype : string
+  (** The [org.ocamlcore.forge.obus.OType] annotation *)
+
+(** {6 Extended types} *)
+
+type basic =
+    private
+  | Byte
+  | Boolean
+  | Int16
+  | Int32
+  | Int64
+  | Uint16
+  | Uint32
+  | Uint64
+  | Double
+  | String
+  | Signature
+  | Object_path
+  | Unix_fd
+  | Enum of OBus_value.T.basic * (OBus_value.V.basic * string) list
+      (** An enumeration. The first argument is the real D-Bus type and
+          the second is a list of [(constant, keyword)].
+
+          For example:
+
+          {[
+            Enum(OBus_value.T.Uint32,
+                 [(OBus_value.V.Uint32 1l, "ok");
+                  (OBus_value.V.Uint32 2l, "fail")])
+          ]}
+
+          Note that the real D-Bus type must be {!OBus_value.T.Byte}
+          or an integer type.
+      *)
+  | Flag of OBus_value.T.basic * (OBus_value.V.basic * string) list
+      (** A flag. The first argument is the real type and the second
+          is a list of [(bits, keyword)].
+
+          For example:
+
+          {[
+            Flag(OBus_value.T.Uint32,
+                 [(OBus_value.V.Uint32 0x01l, "flag1");
+                  (OBus_value.V.Uint32 0x02l, "flag2");
+                  (OBus_value.V.Uint32 0x04l, "flag3")])
+          ]}
+
+          Note that the real D-Bus type must be {!OBus_value.T.Byte}
+          or an integer type.
+      *)
+
+type single =
+  | Basic of basic
+  | Structure of single list
+  | Array of single
+  | Dict of basic * single
+  | Variant
+
+type sequence = single list
+
+(** {8 Constructors} *)
+
+val byte : basic
+val boolean : basic
+val int16 : basic
+val int32 : basic
+val int64 : basic
+val uint16 : basic
+val uint32 : basic
+val uint64 : basic
+val double : basic
+val string : basic
+val signature : basic
+val object_path : basic
+val unix_fd : basic
+val enum : OBus_value.T.basic -> (OBus_value.V.basic * string) list -> basic
+val flag : OBus_value.T.basic -> (OBus_value.V.basic * string) list -> basic
+
+val basic : basic -> single
+val structure : single list -> single
+val array : single -> single
+val dict : basic -> single -> single
+val variant : single
+
+(** {6 Terms} *)
+
+(** A term represent a type, where symbols have not been resolved. *)
+type term =
+    private
+  | Term of string * term list
+      (** A term. Arguments are
+          - the symbol name, which is either the name of a D-Bus type
+            or a user defined type
+          - the arguments taken by the function associated to the
+            symbol *)
+  | Tuple of term list
+      (** A list of terms, packed into a tuple. Tuples are always
+          mapped to D-Bus structures. Moreover it is ensured that there
+          is never a type of the form [Tuple[t]]. *)
+
+val term : string -> term list -> term
+  (** Construct a term *)
+
+val tuple : term list -> term
+  (** Construct a tuple. If the list is of length 1, the type itself
+      is returned. *)
+
+(** {6 Symbols} *)
+
+(** Type of user-definable symbols *)
+type symbol =
+    private
+  | Sym_enum of OBus_value.T.basic * (OBus_value.V.basic * string) list
+  | Sym_flag of OBus_value.T.basic * (OBus_value.V.basic * string) list
+
+val sym_enum : OBus_value.T.basic -> (OBus_value.V.basic * string) list -> symbol
+  (** Create an enumeration *)
+
+val sym_flag : OBus_value.T.basic -> (OBus_value.V.basic * string) list -> symbol
+  (** Create a flag type *)
+
+(** {6 Conversions} *)
+
+(** {8 Stripping} *)
+
+(** The following functions remove extension from types. *)
+
+val strip_basic : basic -> OBus_value.T.basic
+val strip_single : single -> OBus_value.T.single
+val strip_sequence : sequence -> OBus_value.T.sequence
+
+(** {8 Projections} *)
+
+(** The following functions project standard D-Bus types into extended
+    D-Bus types *)
+
+val project_basic : OBus_value.T.basic -> basic
+val project_single : OBus_value.T.single -> single
+val project_sequence : OBus_value.T.sequence -> sequence
+
+(** {8 Types to terms conversions} *)
+
+(** The following functions returns the term associated to a standard
+    D-Bus type *)
+
+val term_of_basic : OBus_value.T.basic -> term
+val term_of_single : OBus_value.T.single -> term
+val term_of_sequence : OBus_value.T.sequence -> term
+
+(** {8 Symbols resolution} *)
+
+type env = (string * symbol) list
+    (** An environment, mapping names to symbol *)
+
+exception Resolve_error of string
+  (** Exception raised when the resolution of symbols of a type
+      fails. *)
+
+val resolve : env -> term -> single
+  (** [resolve env term] resolves symbols of [term] using [env], and
+      returns the extended type it denotes. It raises {!Resolve_error}
+      if a symbol of [term] is not found in [env]. *)
+
+(** {6 Extended introspection ast} *)
+
+type name = string
+
+type annotation = name * string
+type argument = name option * term
+
+type access = OBus_introspect.access = Read | Write | Read_write
+
+type member =
+  | Method of name * argument list * argument list * annotation list
+  | Signal of name * argument list * annotation list
+  | Property of name * term * access * annotation list
+
+type interface = name * member list * (string * symbol) list * annotation list
+
+(** {6 Encoding/decoding} *)
+
+val encode : interface -> OBus_introspect.interface
+  (** Encode the given interface into a standard one by using
+      annotations *)
+
+val decode : OBus_introspect.interface -> interface
+  (** Decode the given standard interface into an extended one by
+      decoding annotations *)
diff --git a/src/internals/oBus_name.ml b/src/internals/oBus_name.ml
new file mode 100644
index 0000000..1d72c0a
--- /dev/null
+++ b/src/internals/oBus_name.ml
@@ -0,0 +1,276 @@
+(*
+ * oBus_name.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 String
+open OBus_string
+
+type bus = string
+type interface = string
+type member = string
+type error = string
+
+(* +-----------------------------------------------------------------+
+   | Bus names                                                       |
+   +-----------------------------------------------------------------+ *)
+
+let is_unique name = length name > 0 && unsafe_get name 0 = ':'
+
+let validate_unique_connection str =
+  let fail i msg = Some{ typ = "unique connection name"; str = str; ofs = i; msg = msg }
+  and len = length str in
+
+  let rec element_start i =
+    if i = len then
+      fail i "empty element"
+    else match unsafe_get str i with
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+          element (i + 1)
+      | '.' ->
+          fail i "empty element"
+      | _ ->
+          fail i "invalid character"
+
+  and element i =
+    if i = len then
+      None
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+          element (i + 1)
+      | _ ->
+          fail i "invalid character"
+
+  and first_element i =
+    if i = len then
+      fail (-1) "must contains at least two elements"
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+          first_element (i + 1)
+      | _ ->
+          fail i "invalid character"
+  in
+
+  if len > OBus_protocol.max_name_length then
+    fail (-1) "name too long"
+  else if len = 1 then
+    fail 1 "premature end of name"
+  else match unsafe_get str 1 with
+    | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+        first_element 2
+    | '.' ->
+        fail 1 "empty element"
+    | _ ->
+        fail 1 "invalid character"
+
+let validate_bus_other str =
+  let fail i msg = Some{ typ = "unique connection name"; str = str; ofs = i; msg = msg }
+  and len = length str in
+
+  let rec element_start i =
+    if i = len then
+      fail i "empty element"
+    else match unsafe_get str i with
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' ->
+          element (i + 1)
+      | '.' ->
+          fail i "empty element"
+      | _ ->
+          fail i "invalid character"
+
+  and element i =
+    if i = len then
+      None
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+          element (i + 1)
+      | _ ->
+          fail i "invalid character"
+
+  and first_element i =
+    if i = len then
+      fail (-1) "must contains at least two elements"
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+          first_element (i + 1)
+      | _ ->
+          fail i "invalid character"
+  in
+
+  if len > OBus_protocol.max_name_length then
+    fail (-1) "name too long"
+  else match unsafe_get str 1 with
+    | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' | '0' .. '9'->
+        first_element 2
+    | '.' ->
+        element_start 2
+    | _ ->
+        fail 1 "invalid character"
+
+let validate_bus = function
+  | "" ->
+      Some{ typ = "bus name"; str = ""; ofs = -1; msg = "empty name" }
+  | str ->
+      match unsafe_get str 0 with
+        | ':' -> validate_unique_connection str
+        | 'A' .. 'Z' | 'a' .. 'z' | '_' | '-' -> validate_bus_other str
+        | '.' -> Some{ typ = "bus name"; str = str; ofs = 0; msg = "empty element" }
+        | _ -> Some{ typ = "bus name"; str = str; ofs = 0; msg = "invalid character" }
+
+(* +-----------------------------------------------------------------+
+   | Interface names                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let validate_interface str =
+  let fail i msg = Some{ typ = "interface name"; str = str; ofs = i; msg = msg }
+  and len = length str in
+
+  let rec element_start i =
+    if i = len then
+      fail i "empty element"
+    else match unsafe_get str i with
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' ->
+          element (i + 1)
+      | '.' ->
+          fail i "empty element"
+      | _ ->
+          fail i "invalid character"
+
+  and element i =
+    if i = len then
+      None
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '0' .. '9' ->
+          element (i + 1)
+      | _ ->
+          fail i "invalid character"
+
+  and first_element i =
+    if i = len then
+      fail (-1) "must contains at least two elements"
+    else match unsafe_get str i with
+      | '.' ->
+          element_start (i + 1)
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '0' .. '9' ->
+          first_element (i + 1)
+      | _ ->
+          fail i "invalid character"
+  in
+
+  if len > OBus_protocol.max_name_length then
+    fail (-1) "name too long"
+  else if len = 0 then
+    fail (-1) "empty name"
+  else match unsafe_get str 0 with
+    | 'A' .. 'Z' | 'a' .. 'z' | '_' ->
+        first_element 1
+    | '.' ->
+        fail 0 "empty element"
+    | _ ->
+        fail 0 "invalid character"
+
+(* +-----------------------------------------------------------------+
+   | Member names                                                    |
+   +-----------------------------------------------------------------+ *)
+
+let validate_member str =
+  let fail i msg = Some{ typ = "member name"; str = str; ofs = i; msg = msg }
+  and len = length str in
+
+  let rec aux i =
+    if i = len then
+      None
+    else match unsafe_get str i with
+      | 'A' .. 'Z' | 'a' .. 'z' | '_' | '0' .. '9' ->
+          aux (i + 1)
+      | _ ->
+          fail i "invalid character"
+  in
+
+  if len > OBus_protocol.max_name_length then
+    fail (-1) "name too long"
+  else if len = 0 then
+    fail (-1) "empty name"
+  else match unsafe_get str 0 with
+    | 'A' .. 'Z' | 'a' .. 'z' | '_' ->
+        aux 1
+    | _ ->
+        fail 0 "invalid character"
+
+(* +-----------------------------------------------------------------+
+   | Error names                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let validate_error str =
+  (* Error names have the same restriction as interface names *)
+  match validate_interface str with
+    | None ->
+        None
+    | Some error ->
+        Some{ error with typ = "error name" }
+
+(* +-----------------------------------------------------------------+
+   | Name translation                                                |
+   +-----------------------------------------------------------------+ *)
+
+(* Split a name into blocks. Blocks are the longest sub-strings
+   matched by the regulare expression: "[A-Z]*[^A-Z.]*" *)
+let split name =
+
+  (* Recognize the first part of a block: "[A-Z]*" *)
+  let rec part1 i =
+    if i = String.length name then
+      i
+    else
+      match name.[i] with
+        | 'A' .. 'Z' ->
+            part1 (i + 1)
+        | _ ->
+            part2 i
+
+  (* Recognize the second part of a block: "[^A-Z.]*" *)
+  and part2 i =
+    if i = String.length name then
+      i
+    else
+      match name.[i] with
+        | 'A' .. 'Z' | '.' ->
+            i
+        | _ ->
+            part2 (i + 1)
+
+  in
+
+  let rec split i =
+    if i = String.length name then
+      []
+    else
+      let j = part1 i in
+      if j = i then
+        (* Skip empty blocks *)
+        split (i + 1)
+      else
+        String.sub name i (j - i) :: split j
+
+  in
+  split 0
+
+let ocaml_lid name = String.uncapitalize_ascii (String.concat "_" (List.map String.lowercase_ascii (split name)))
+let ocaml_uid name = String.capitalize_ascii (String.concat "_" (List.map String.lowercase_ascii (split name)))
+
+let haskell_lid name = String.uncapitalize_ascii (String.concat "" (split name))
+let haskell_uid name = String.capitalize_ascii (String.concat "" (split name))
diff --git a/src/internals/oBus_name.mli b/src/internals/oBus_name.mli
new file mode 100644
index 0000000..aac68e5
--- /dev/null
+++ b/src/internals/oBus_name.mli
@@ -0,0 +1,78 @@
+(*
+ * oBus_name.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus names *)
+
+(** For specific restrictions on D-Bus names, see
+    @see <http://dbus.freedesktop.org/doc/dbus-specification.html#message-protocol-names> the specification
+
+    General restrictions include:
+
+    - names must not be empty
+    - names must contains only ascii characters *)
+
+type bus = OBus_string.t
+    (** Bus names
+
+        example: "org.freedesktop.DBus", ":1.1" *)
+
+val validate_bus : OBus_string.validator
+
+val is_unique : bus -> bool
+  (** Tell wether a bus name is a unique connection name or not. *)
+
+type interface = OBus_string.t
+    (** Interface names
+
+        example: "org.freedesktop.DBus.Introspectable" *)
+
+val validate_interface : OBus_string.validator
+
+type member = OBus_string.t
+    (** Methods/signals/properties names
+
+        example: "StartServiceByName" *)
+
+val validate_member : OBus_string.validator
+
+type error = OBus_string.t
+    (** Error names
+
+        example: "org.freedesktop.Error.UnknownMethod" *)
+
+val validate_error : OBus_string.validator
+
+(** {6 D-Bus name translation} *)
+
+val split : string -> string list
+  (** Split a name into longest blocks matched by the regular
+      expression "[A-Z]*[^A-Z.]*":
+
+      [split "SetCPUFreqGovernor" = ["Set"; "CPUFreq"; "Governor"]],
+      [split "org.freedesktop.DBus" = ["org"; "freedesktop"; "DBus"]] *)
+
+val ocaml_lid : string -> string
+  (** Translate a D-Bus name into an ocaml-style lower-identifier:
+
+      [caml_lid "SetCPUFreqGovernor" = "set_cpufreq_governor"] *)
+
+val ocaml_uid : string -> string
+  (** Translate a D-Bus name into an ocaml-style upper-identifier:
+
+      [caml_uid "org.freedesktop.DBus" = "Org_freedesktop_dbus"] *)
+
+val haskell_lid : string -> string
+  (** Translate a D-Bus name into an haskell-style lower-identifier:
+
+      [haskell_lid "SetCPUFreqGovernor" = "setCPUFreqGovernor"] *)
+
+val haskell_uid : string -> string
+  (** Translate a D-Bus name into an haskell-style upper-identifier:
+
+      [haskell_uid "org.freedesktop.DBus" = "OrgFreedesktopDBus"] *)
diff --git a/src/internals/oBus_path.ml b/src/internals/oBus_path.ml
new file mode 100644
index 0000000..3956178
--- /dev/null
+++ b/src/internals/oBus_path.ml
@@ -0,0 +1,146 @@
+(*
+ * oBus_path.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 Printf
+open String
+open OBus_string
+
+type element = string
+type t = element list
+
+let compare = Pervasives.compare
+
+let is_valid_char ch =
+  (ch >= 'A' && ch <= 'Z') ||
+    (ch >= 'a' && ch <= 'z') ||
+    (ch >= '0' && ch <= '9') ||
+    ch = '_'
+
+let validate str =
+  let fail i msg = Some{ typ = "path"; str = str; ofs = i; msg = msg }
+  and len = length str in
+
+  let rec aux_element_start i =
+    if i = len then
+      fail (i - 1) "trailing '/'"
+    else if is_valid_char (unsafe_get str i) then
+      aux_element (i + 1)
+    else if unsafe_get str i = '/' then
+      fail i "empty element"
+    else
+      fail i "invalid char"
+
+  and aux_element i =
+    if i = len then
+      None
+    else
+      let ch = unsafe_get str i in
+      if ch = '/' then
+        aux_element_start (i + 1)
+      else if is_valid_char ch then
+        aux_element (i + 1)
+      else
+        fail i "invalid char"
+  in
+
+  if len = 0 then
+    fail (-1) "empty path"
+  else if unsafe_get str 0 = '/' then
+    if len = 1 then None else aux_element_start 1
+  else
+    fail 0 "must start with '/'"
+
+let validate_element = function
+  | "" ->
+      Some{ typ = "path element"; str = ""; ofs = -1; msg = "empty element" }
+  | str ->
+      let len = length str in
+      let rec aux i =
+        if i = len then
+          None
+        else if is_valid_char (unsafe_get str i) then
+          aux (i + 1)
+        else
+          Some{ typ = "path element"; str = ""; ofs = i; msg = "invalid character" }
+      in
+      aux 0
+
+let empty = []
+
+let to_string = function
+  | [] -> "/"
+  | path ->
+      let str = Bytes.create (List.fold_left (fun len elt -> len + length elt + 1) 0 path) in
+      ignore
+        (List.fold_left
+           (fun pos elt ->
+              match validate_element elt with
+                | None ->
+                    Bytes.unsafe_set str pos '/';
+                    let len = length elt in
+                    unsafe_blit elt 0 str (pos + 1) len;
+                    pos + 1 + len
+                | Some error ->
+                    raise (Invalid_string error))
+           0 path);
+      Bytes.unsafe_to_string str
+
+let of_string str =
+  match validate str with
+    | Some error ->
+        raise (OBus_string.Invalid_string error)
+    | None ->
+        let rec aux acc j =
+          if j <= 0 then
+            acc
+          else
+            let i = rindex_from str j '/' in
+            let len = j - i in
+            let elt = Bytes.create len in
+            unsafe_blit str (i + 1) elt 0 len;
+            let elt = Bytes.unsafe_to_string elt in
+            aux (elt :: acc) (i - 1)
+        in
+        aux [] (length str - 1)
+
+let escape s =
+  let len = length s in
+  let r = Bytes.create (len * 2) in
+  for i = 0 to len - 1 do
+    let j = i * 2 and n = int_of_char s.[i] in
+    Bytes.set r j (char_of_int (n land 15 + int_of_char 'a'));
+    Bytes.set r (j + 1) (char_of_int (n lsr 4 + int_of_char 'a'))
+  done;
+  Bytes.unsafe_to_string r
+
+let unescape s =
+  let len = length s / 2 in
+  let r = Bytes.create len in
+  for i = 0 to len - 1 do
+    let j = i * 2 in
+    Bytes.set r i (char_of_int ((int_of_char s.[j] - int_of_char 'a') lor
+                                ((int_of_char s.[j + 1] - int_of_char 'a') lsl 4)))
+  done;
+  Bytes.unsafe_to_string r
+
+let rec after prefix path = match prefix, path with
+  | [], p -> Some p
+  | e1 :: p1, e2 :: p2 when e1 = e2 -> after p1 p2
+  | _ -> None
+
+let unique_id = ref (0, 0)
+
+let generate () =
+  let id1 , id2 = !unique_id in
+  let id2 = id2 + 1 in
+  if id2 < 0 then
+    unique_id := (id1 + 1, 0)
+  else
+    unique_id := (id1, id2);
+  ["org"; "ocamlcore"; "forge"; "obus"; sprintf "%d_%d" id1 id2]
diff --git a/src/internals/oBus_path.mli b/src/internals/oBus_path.mli
new file mode 100644
index 0000000..33f8744
--- /dev/null
+++ b/src/internals/oBus_path.mli
@@ -0,0 +1,54 @@
+(*
+ * oBus_path.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Manipulation of dbus object paths *)
+
+type element = string
+    (** A path component *)
+
+type t = element list
+    (** A complete path *)
+
+val compare : t -> t -> int
+  (** Same as [Pervasives.compare]. It allows this module to be used
+      as argument to the functors [Set.Make] and [Map.Make]. *)
+
+(** {6 Construction} *)
+
+val empty : t
+  (** Empty path *)
+
+val after : t -> t -> t option
+  (** [after prefix path] if [path = prefix @ p] return [Some p], and
+      [None] if not *)
+
+val of_string : string -> t
+  (** Create an object path from a string.
+
+      @raise OBus_string.Invalid_string if the given string does not
+      represent a valid object path *)
+
+val to_string : t -> string
+  (** Return a string representation of an object path *)
+
+(** {6 Helpers} *)
+
+val escape : string -> element
+  (** Escape an arbitrary string into a valid element *)
+
+val unescape : element -> string
+  (** Interpret escape sequence to get back the original string *)
+
+val generate : unit -> t
+  (** [generate ()] generate a new unique path *)
+
+(** {6 Validation} *)
+
+val validate : OBus_string.validator
+val validate_element : OBus_string.validator
diff --git a/src/internals/oBus_protocol.ml b/src/internals/oBus_protocol.ml
new file mode 100644
index 0000000..ffbe951
--- /dev/null
+++ b/src/internals/oBus_protocol.ml
@@ -0,0 +1,19 @@
+(*
+ * oBus_protocol.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Protocol parameters *)
+
+let max_type_recursion_depth = 32
+let max_name_length = 255
+let max_array_size = 1 lsl 26
+let max_message_size = 1 lsl 27
+
+let bus_name = "org.freedesktop.DBus"
+let bus_path = ["org"; "freedesktop"; "DBus"]
+let bus_interface = "org.freedesktop.DBus"
diff --git a/src/internals/oBus_string.ml b/src/internals/oBus_string.ml
new file mode 100644
index 0000000..8d6221a
--- /dev/null
+++ b/src/internals/oBus_string.ml
@@ -0,0 +1,115 @@
+(*
+ * oBus_string.ml
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+type t = string
+
+type error = {
+  typ : string;
+  str : string;
+  ofs : int;
+  msg : string;
+}
+
+let typ e = e.typ
+let str e = e.str
+let ofs e = e.ofs
+let msg e = e.msg
+
+type validator = string -> error option
+
+exception Invalid_string of error
+
+let error_message error =
+  if error.ofs < 0 then
+    Printf.sprintf "invalid D-Bus %s (%S): %s" error.typ error.str error.msg
+  else
+    Printf.sprintf "invalid D-Bus %s (%S), at position %d: %s" error.typ error.str error.ofs error.msg
+
+let () =
+  Printexc.register_printer
+    (function
+       | Invalid_string error ->
+           Some(error_message error)
+       | _ ->
+           None)
+
+let () =
+  Printexc.register_printer
+    (function
+       | Invalid_string error ->
+           Some(error_message error)
+       | _ ->
+           None)
+
+let validate s =
+  let fail i msg = Some{ typ = "string"; str = s; ofs = i; msg = msg } in
+  let len = String.length s in
+  let rec main i =
+    if i = len then
+      None
+    else
+      let ch = String.unsafe_get s i in
+      match ch with
+        | '\x00' ->
+            fail i "null byte"
+        | '\x01' .. '\x7f' ->
+            main (i + 1)
+        | '\xc0' .. '\xdf' ->
+            if i + 1 >= len then
+              fail len "premature end of UTF8 sequence"
+            else begin
+              let byte1 = Char.code (String.unsafe_get s (i + 1)) in
+              if byte1 land 0xc0 != 0x80 then
+                fail (i + 1) "malformed UTF8 sequence"
+              else if ((Char.code ch land 0x1f) lsl 6) lor (byte1 land 0x3f) < 0x80 then
+                fail i "overlong UTF8 sequence"
+              else
+                main (i + 2)
+            end
+        | '\xe0' .. '\xef' ->
+            if i + 2 >= len then
+              fail len "premature end of UTF8 sequence"
+            else begin
+              let byte1 = Char.code (String.unsafe_get s (i + 1))
+              and byte2 = Char.code (String.unsafe_get s (i + 2)) in
+              if byte1 land 0xc0 != 0x80 then
+                fail (i + 1) "malformed UTF8 sequence"
+              else if byte2 land 0xc0 != 0x80 then
+                fail (i + 2) "malformed UTF8 sequence"
+              else if ((Char.code ch land 0x0f) lsl 12) lor ((byte1 land 0x3f) lsl 6) lor (byte2 land 0x3f) < 0x800 then
+                fail i "overlong UTF8 sequence"
+              else
+                main (i + 3)
+            end
+        | '\xf0' .. '\xf7' ->
+            if i + 3 >= len then
+              fail len "premature end of UTF8 sequence"
+            else begin
+              let byte1 = Char.code (String.unsafe_get s (i + 1))
+              and byte2 = Char.code (String.unsafe_get s (i + 2))
+              and byte3 = Char.code (String.unsafe_get s (i + 3)) in
+              if byte1 land 0xc0 != 0x80 then
+                fail (i + 1) "malformed UTF8 sequence"
+              else if byte2 land 0xc0 != 0x80 then
+                fail (i + 2) "malformed UTF8 sequence"
+              else if byte3 land 0xc0 != 0x80 then
+                fail (i + 3) "malformed UTF8 sequence"
+              else if ((Char.code ch land 0x0f) lsl 18) lor ((byte1 land 0x3f) lsl 12) lor ((byte2 land 0x3f) lsl 6) lor (byte3 land 0x3f) < 0x10000 then
+                fail i "overlong UTF8 sequence"
+              else
+                main (i + 4)
+            end
+        | _ ->
+            fail i "invalid start of UTF8 sequence"
+  in
+  main 0
+
+let assert_validate validator str = match validator str with
+  | Some error -> raise (Invalid_string error)
+  | None -> ()
diff --git a/src/internals/oBus_string.mli b/src/internals/oBus_string.mli
new file mode 100644
index 0000000..1e67a6a
--- /dev/null
+++ b/src/internals/oBus_string.mli
@@ -0,0 +1,65 @@
+(*
+ * oBus_string.mli
+ * ---------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Restriction on strings used with D-Bus *)
+
+(** There are a lot of restrictions for strings used in D-Bus.
+    OBus only verifies strings when a message is sent or received *)
+
+type error = {
+  (** Contains informations about invalid strings *)
+
+  typ : string;
+  (** Type of string ("string", "bus name", "error name", "path",
+      ...) *)
+
+  str : string;
+  (** The string which fail to validate *)
+
+  ofs : int;
+  (** is the position in bytes where the validation failed *)
+
+  msg : string;
+  (** explains why the string failed to validate *)
+}
+
+val error_message : error -> string
+  (** [error_message error] returns a human-readable error message *)
+
+(** {8 Error projections} *)
+
+val typ : error -> string
+val str : error -> string
+val ofs : error -> int
+val msg : error -> string
+
+(** {6 Validators} *)
+
+type validator = string -> error option
+  (** Tests if a string is correct.
+
+      - if it is, returns [None]
+      - if not, returns [Some(ofs, msg)] *)
+
+exception Invalid_string of error
+
+val assert_validate : validator -> string -> unit
+  (** Raises {!Invalid_string} if the given string failed to
+      validate *)
+
+(** {6 Common strings} *)
+
+type t = string
+    (** Type for common strings, restrictions are:
+
+        - a string must be encoded in valid UTF-8
+        - a string must not contains the null byte *)
+
+val validate : validator
+  (** Validation function for common strings *)
diff --git a/src/internals/oBus_type_ext_lexer.mll b/src/internals/oBus_type_ext_lexer.mll
new file mode 100644
index 0000000..de72963
--- /dev/null
+++ b/src/internals/oBus_type_ext_lexer.mll
@@ -0,0 +1,105 @@
+(*
+ * oBus_type_ext_lexer.mll
+ * -----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+{
+  open OBus_value
+
+  exception Fail of int * string
+
+  let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum
+
+  let fail lexbuf fmt =
+    Printf.ksprintf
+      (fun msg -> raise (Fail(pos lexbuf, msg)))
+      fmt
+
+  type term =
+    | Term of string * term list
+    | Tuple of term list
+
+  let term name args = Term(name, args)
+  let tuple = function
+    | [t] -> t
+    | l -> Tuple l
+}
+
+let int = ['-' '+']? ['0'-'9']+
+let space = [' ' '\t' '\n']
+let ident = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*
+
+rule enum_and_flag = parse
+  | space* (ident as name) space* ":" (ident as typ) "="
+      { let typ = match typ with
+          | "byte" -> T.Byte
+          | "int16" -> T.Int16
+          | "int32" -> T.Int32
+          | "int64" -> T.Int64
+          | "uint16" -> T.Uint16
+          | "uint32" -> T.Uint32
+          | "uint64" -> T.Uint64
+          | _ -> fail lexbuf "invalid key type: %S" typ
+        in
+        let values = values typ lexbuf in
+        eoi lexbuf;
+        (name, typ, values) }
+  | ""
+      { fail lexbuf "syntax error" }
+
+and eoi = parse
+  | space* eof { () }
+  | "" { fail lexbuf "syntax error" }
+
+and values typ = parse
+  | space* (int as key) space* ":" space* (ident as name)
+      {
+        let key = match typ with
+          | T.Byte -> V.Byte(char_of_int (int_of_string key))
+          | T.Int16 -> V.Int16(int_of_string key)
+          | T.Int32 -> V.Int32(Int32.of_string key)
+          | T.Int64 -> V.Int64(Int64.of_string key)
+          | T.Uint16 -> V.Uint16(int_of_string key)
+          | T.Uint32 -> V.Uint32(Int32.of_string key)
+          | T.Uint64 -> V.Uint64(Int64.of_string key)
+          | _ -> assert false
+        in
+        if comma lexbuf then
+          (key, name) :: values typ lexbuf
+        else
+          [(key, name)]
+      }
+  | ""
+      {
+        fail lexbuf "syntax error"
+      }
+
+and comma = parse
+  | space* "," { true }
+  | "" { false }
+
+and single = parse
+  | space* (ident as name)
+      { term name [] }
+  | space* "(" (ident as name)
+      { term name (type_args lexbuf) }
+  | space* "<"
+      { tuple (tuple_args lexbuf) }
+  | "" { fail lexbuf "syntax error" }
+
+and type_args = parse
+  | space* ")" { [] }
+  | "" { let typ = single lexbuf in typ :: type_args lexbuf }
+
+and tuple_args = parse
+  | space* ">" { [] }
+  | "" { let typ = single lexbuf in typ :: tuple_args2 lexbuf }
+
+and tuple_args2 = parse
+  | space* ">" { [] }
+  | space* "," { let typ = single lexbuf in typ :: tuple_args2 lexbuf }
+  | "" { fail lexbuf "syntax error" }
diff --git a/src/internals/oBus_util.ml b/src/internals/oBus_util.ml
new file mode 100644
index 0000000..d7fdcf1
--- /dev/null
+++ b/src/internals/oBus_util.ml
@@ -0,0 +1,241 @@
+(*
+ * oBus_util.ml
+ * ------------
+ * Copyright : (c) 2009, 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(util)"
+
+let rec assoc x = function
+  | [] -> None
+  | (k, v) :: _ when k = x -> Some(v)
+  | _ :: l -> assoc x l
+
+let rec assq x = function
+  | [] -> None
+  | (k, v) :: _ when k == x -> Some(v)
+  | _ :: l -> assq x l
+
+let rec find_map f = function
+  | [] -> None
+  | x :: l -> match f x with
+      | None -> find_map f l
+      | y -> y
+
+let filter_map f l =
+  List.fold_right (fun x acc -> match f x with
+                    | None -> acc
+                    | Some(v) -> v :: acc) l []
+
+let part_map f l =
+  List.fold_right (fun x (success, failure) -> match f x with
+                     | None -> (success, x :: failure)
+                     | Some(v) -> (v :: success, failure)) l ([], [])
+
+type ('a, 'b) either =
+  | InL of 'a
+  | InR of 'b
+
+let split f l =
+  List.fold_right (fun x (a, b) -> match f x with
+                     | InL x -> (x :: a, b)
+                     | InR x -> (a, x :: b)) l ([], [])
+
+let map_option x f = match x with
+  | Some x -> Some(f x)
+  | None -> None
+
+let encode_char n =
+  if n < 10 then
+    char_of_int (n + Char.code '0')
+  else if n < 16 then
+    char_of_int (n + Char.code 'a' - 10)
+  else
+    assert false
+
+let hex_encode str =
+  let len = String.length str in
+  let hex = Bytes.create (len * 2) in
+  for i = 0 to len - 1 do
+    let n = Char.code (String.unsafe_get str i) in
+    Bytes.unsafe_set hex (i * 2) (encode_char (n lsr 4));
+    Bytes.unsafe_set hex (i * 2 + 1) (encode_char (n land 15))
+  done;
+  Bytes.unsafe_to_string hex
+
+let decode_char ch = match ch with
+  | '0'..'9' -> Char.code ch - Char.code '0'
+  | 'a'..'f' -> Char.code ch - Char.code 'a' + 10
+  | 'A'..'F' -> Char.code ch - Char.code 'A' + 10
+  | _ -> raise (Invalid_argument "OBus_util.decode_char")
+
+let hex_decode hex =
+  if String.length hex mod 2 <> 0 then raise (Invalid_argument "OBus_util.hex_decode");
+  let len = String.length hex / 2 in
+  let str = Bytes.create len in
+  for i = 0 to len - 1 do
+    Bytes.unsafe_set str i
+      (char_of_int
+         ((decode_char (String.unsafe_get hex (i * 2)) lsl 4) lor
+            (decode_char (String.unsafe_get hex (i * 2 + 1)))))
+  done;
+  Bytes.unsafe_to_string str
+
+let homedir = lazy(
+  try
+    Lwt.return (Sys.getenv "HOME")
+  with Not_found ->
+    let%lwt pwd = Lwt_unix.getpwuid (Unix.getuid ()) in
+    Lwt.return pwd.Unix.pw_dir
+)
+
+let init_pseudo = Lazy.from_fun Random.self_init
+
+let fill_pseudo buffer pos len =
+  ignore (Lwt_log.warning ~section "using pseudo-random generator");
+  Lazy.force init_pseudo;
+  for i = pos to pos + len - 1 do
+    Bytes.unsafe_set buffer i (char_of_int (Random.int 256))
+  done
+
+let fill_random buffer pos len =
+  try
+    let ic = open_in "/dev/urandom" in
+    let n = input ic buffer pos len in
+    if n < len then fill_pseudo buffer (pos + n) (len - n);
+    close_in ic
+  with exn ->
+    ignore (Lwt_log.warning_f ~exn ~section "failed to get random data from /dev/urandom");
+    fill_pseudo buffer pos len
+
+let random_string n =
+  let str = Bytes.create n in
+  fill_random str 0 n;
+  Bytes.unsafe_to_string str
+
+let random_int32 () =
+  let r = random_string 4 in
+  Int32.logor
+    (Int32.logor
+       (Int32.of_int (Char.code r.[0]))
+       (Int32.shift_left (Int32.of_int (Char.code r.[1])) 8))
+    (Int32.logor
+       (Int32.shift_left (Int32.of_int (Char.code r.[2])) 16)
+       (Int32.shift_left (Int32.of_int (Char.code r.[3])) 24))
+
+let random_int () = Int32.to_int (random_int32 ())
+
+let random_int64 () =
+  Int64.logor
+    (Int64.of_int32 (random_int32 ()))
+    (Int64.shift_left (Int64.of_int32 (random_int32 ())) 32)
+
+(* Compute the sha1 of a string.
+
+   Copied from uuidm by Daniel C. Bünzli, which can be found here:
+   http://erratique.ch/software/uuidm *)
+let sha_1 s =
+  let sha_1_pad s =
+    let len = String.length s in
+    let blen = 8 * len in
+    let rem = len mod 64 in
+    let mlen = if rem > 55 then len + 128 - rem else len + 64 - rem in
+    let m = Bytes.create mlen in
+    Bytes.blit_string s 0 m 0 len;
+    Bytes.fill m len (mlen - len) '\x00';
+    Bytes.set m len '\x80';
+    if Sys.word_size > 32 then begin
+      Bytes.set m (mlen - 8) (Char.unsafe_chr (blen lsr 56 land 0xFF));
+      Bytes.set m (mlen - 7) (Char.unsafe_chr (blen lsr 48 land 0xFF));
+      Bytes.set m (mlen - 6) (Char.unsafe_chr (blen lsr 40 land 0xFF));
+      Bytes.set m (mlen - 5) (Char.unsafe_chr (blen lsr 32 land 0xFF));
+    end;
+    Bytes.set m (mlen - 4) (Char.unsafe_chr (blen lsr 24 land 0xFF));
+    Bytes.set m (mlen - 3) (Char.unsafe_chr (blen lsr 16 land 0xFF));
+    Bytes.set m (mlen - 2) (Char.unsafe_chr (blen lsr 8 land 0xFF));
+    Bytes.set m (mlen - 1) (Char.unsafe_chr (blen land 0xFF));
+    Bytes.unsafe_to_string m
+  in
+  (* Operations on int32 *)
+  let ( &&& ) = ( land ) in
+  let ( lor ) = Int32.logor in
+  let ( lxor ) = Int32.logxor in
+  let ( land ) = Int32.logand in
+  let ( ++ ) = Int32.add in
+  let lnot = Int32.lognot in
+  let sr = Int32.shift_right in
+  let sl = Int32.shift_left in
+  let cls n x = (sl x n) lor (Int32.shift_right_logical x (32 - n)) in
+  (* Start *)
+  let m = sha_1_pad s in
+  let w = Array.make 16 0l in
+  let h0 = ref 0x67452301l in
+  let h1 = ref 0xEFCDAB89l in
+  let h2 = ref 0x98BADCFEl in
+  let h3 = ref 0x10325476l in
+  let h4 = ref 0xC3D2E1F0l in
+  let a = ref 0l in
+  let b = ref 0l in
+  let c = ref 0l in
+  let d = ref 0l in
+  let e = ref 0l in
+  for i = 0 to ((String.length m) / 64) - 1 do             (* For each block *)
+    (* Fill w *)
+    let base = i * 64 in
+    for j = 0 to 15 do
+      let k = base + (j * 4) in
+      w.(j) <- sl (Int32.of_int (Char.code m.[k])) 24 lor
+        sl (Int32.of_int (Char.code m.[k + 1])) 16 lor
+        sl (Int32.of_int (Char.code m.[k + 2])) 8 lor
+        (Int32.of_int (Char.code m.[k + 3]))
+    done;
+    (* Loop *)
+    a := !h0; b := !h1; c := !h2; d := !h3; e := !h4;
+    for t = 0 to 79 do
+      let f, k =
+        if t <= 19 then (!b land !c) lor ((lnot !b) land !d), 0x5A827999l else
+          if t <= 39 then !b lxor !c lxor !d, 0x6ED9EBA1l else
+            if t <= 59 then
+	      (!b land !c) lor (!b land !d) lor (!c land !d), 0x8F1BBCDCl
+	    else
+              !b lxor !c lxor !d, 0xCA62C1D6l
+      in
+      let s = t &&& 0xF in
+      if (t >= 16) then begin
+	w.(s) <- cls 1 begin
+	  w.((s + 13) &&& 0xF) lxor
+	    w.((s + 8) &&& 0xF) lxor
+	    w.((s + 2) &&& 0xF) lxor
+	    w.(s)
+	end
+      end;
+      let temp = (cls 5 !a) ++ f ++ !e ++ w.(s) ++ k in
+      e := !d;
+      d := !c;
+      c := cls 30 !b;
+      b := !a;
+      a := temp;
+    done;
+    (* Update *)
+    h0 := !h0 ++ !a;
+    h1 := !h1 ++ !b;
+    h2 := !h2 ++ !c;
+    h3 := !h3 ++ !d;
+    h4 := !h4 ++ !e
+  done;
+  let h = Bytes.create 20 in
+  let i2s h k i =
+    Bytes.set h (k    ) (Char.unsafe_chr ((Int32.to_int (sr i 24)) &&& 0xFF));
+    Bytes.set h (k + 1) (Char.unsafe_chr ((Int32.to_int (sr i 16)) &&& 0xFF));
+    Bytes.set h (k + 2) (Char.unsafe_chr ((Int32.to_int (sr i 8)) &&& 0xFF));
+    Bytes.set h (k + 3) (Char.unsafe_chr ((Int32.to_int i) &&& 0xFF));
+  in
+  i2s h 0 !h0;
+  i2s h 4 !h1;
+  i2s h 8 !h2;
+  i2s h 12 !h3;
+  i2s h 16 !h4;
+  Bytes.unsafe_to_string h
diff --git a/src/internals/oBus_util.mli b/src/internals/oBus_util.mli
new file mode 100644
index 0000000..80e45e9
--- /dev/null
+++ b/src/internals/oBus_util.mli
@@ -0,0 +1,64 @@
+(*
+ * oBus_util.mli
+ * -------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** This module contain various functions used by both the library and
+    the tools *)
+
+val assoc : 'a -> ('a * 'b) list -> 'b option
+  (** Same as List.assoc but return an option *)
+
+val assq : 'a -> ('a * 'b) list -> 'b option
+  (** Same as List.assq but return an option *)
+
+val find_map : ('a -> 'b option) -> 'a list -> 'b option
+  (** [find_map f l] Apply [f] on each element of [l] until it return
+      [Some x] and return that result or return [None] *)
+
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+  (** [filter_map f l] apply [f] on each element of [l] and return the
+      list ef element for which [f] succeed (i.e. return [Some x]) *)
+
+val part_map : ('a -> 'b option) -> 'a list -> 'b list * 'a list
+  (** [part_map f l] apply [f] on each element of [l] and return the
+      list of success and the list of failure *)
+
+type ('a, 'b) either =
+  | InL of 'a
+  | InR of 'b
+
+val split : ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list
+  (** Split a list *)
+
+val map_option : 'a option -> ('a -> 'b) -> 'b option
+
+val sha_1 : string -> string
+  (** Compute the sha1 of a string *)
+
+val hex_encode : string -> string
+val hex_decode : string -> string
+  (** A hex-encoded string is a string where each character is
+      replaced by two hexadecimal characters which represent his ascii
+      code *)
+
+val homedir : string Lwt.t Lazy.t
+  (** The home directory *)
+
+(** {6 Random number generation} *)
+
+(** All the following functions try to generate random numbers using
+    /dev/urandom and can fallback to pseudo-random generator *)
+
+val fill_random : bytes -> int -> int -> unit
+  (** [fill_random str ofs len] Fill the given string from [ofs] to
+      [ofs+len-1] with random bytes.  *)
+
+val random_string : int -> string
+val random_int : unit -> int
+val random_int32 : unit -> int32
+val random_int64 : unit -> int64
diff --git a/src/internals/oBus_value.ml b/src/internals/oBus_value.ml
new file mode 100644
index 0000000..142f4b4
--- /dev/null
+++ b/src/internals/oBus_value.ml
@@ -0,0 +1,1198 @@
+(*
+ * oBus_value.mlp
+ * --------------
+ * 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(value)"
+
+open Format
+
+let print_seq left right sep f pp l =
+  pp_print_string pp left;
+  begin match l with
+    | [] -> ()
+    | x :: l ->
+        pp_open_box pp 0;
+        f pp x;
+        List.iter (fprintf pp "%s@ %a" sep f) l;
+        pp_close_box pp ()
+  end;
+  pp_print_string pp right
+
+let print_list f = print_seq "[" "]" ";" f
+let print_tuple f = print_seq "(" ")" "," f
+
+let string_of printer x =
+  let buf = Buffer.create 42 in
+  let pp = formatter_of_buffer buf in
+  pp_set_margin pp max_int;
+  printer pp x;
+  pp_print_flush pp ();
+  Buffer.contents buf
+
+module T =
+struct
+
+  (* +---------------------------------------------------------------+
+     | D-Bus type definitions |
+     +---------------------------------------------------------------+ *)
+
+  type basic =
+    | Byte
+    | Boolean
+    | Int16
+    | Int32
+    | Int64
+    | Uint16
+    | Uint32
+    | Uint64
+    | Double
+    | String
+    | Signature
+    | Object_path
+    | Unix_fd
+
+  type single =
+    | Basic of basic
+    | Structure of single list
+    | Array of single
+    | Dict of basic * single
+    | Variant
+
+  type sequence = single list
+
+  let byte = Byte
+  let boolean = Boolean
+  let int16 = Int16
+  let int32 = Int32
+  let int64 = Int64
+  let uint16 = Uint16
+  let uint32 = Uint32
+  let uint64 = Uint64
+  let double = Double
+  let string = String
+  let signature = Signature
+  let object_path = Object_path
+  let unix_fd = Unix_fd
+
+  let basic_byte = Basic Byte
+  let basic_boolean = Basic Boolean
+  let basic_int16 = Basic Int16
+  let basic_int32 = Basic Int32
+  let basic_int64 = Basic Int64
+  let basic_uint16 = Basic Uint16
+  let basic_uint32 = Basic Uint32
+  let basic_uint64 = Basic Uint64
+  let basic_double = Basic Double
+  let basic_string = Basic String
+  let basic_signature = Basic Signature
+  let basic_object_path = Basic Object_path
+  let basic_unix_fd = Basic Unix_fd
+
+  let basic t = Basic t
+  let structure t = Structure t
+  let array t = Array t
+  let dict tk tv = Dict(tk, tv)
+  let variant = Variant
+
+  (* +---------------------------------------------------------------+
+     | D-Bus types pretty-printing |
+     +---------------------------------------------------------------+ *)
+
+  let string_of_basic = function
+    | Byte -> "T.Byte"
+    | Boolean -> "T.Boolean"
+    | Int16 -> "T.Int16"
+    | Int32 -> "T.Int32"
+    | Int64 -> "T.Int64"
+    | Uint16 -> "T.Uint16"
+    | Uint32 -> "T.Uint32"
+    | Uint64 -> "T.Uint64"
+    | Double -> "T.Double"
+    | String -> "T.String"
+    | Signature -> "T.Signature"
+    | Object_path -> "T.Object_path"
+    | Unix_fd -> "T.Unix_fd"
+
+  let print_basic pp t = pp_print_string pp (string_of_basic t)
+
+  let rec print_single pp = function
+    | Basic t -> fprintf pp "@[<2>T.Basic@ %a@]" print_basic t
+    | Array t -> fprintf pp "@[<2>T.Array@,(%a)@]" print_single t
+    | Dict(tk, tv) -> fprintf pp "@[<2>T.Dict@,(@[<hv>%a,@ %a@])@]" print_basic tk print_single tv
+    | Structure tl -> fprintf pp "@[<2>T.Structure@ %a@]" print_sequence tl
+    | Variant -> fprintf pp "T.Variant"
+
+  and print_sequence pp = print_list print_single pp
+
+  let string_of_single = string_of print_single
+  let string_of_sequence = string_of print_sequence
+end
+
+type signature = T.sequence
+
+(* +-----------------------------------------------------------------+
+   | Signature validation |
+   +-----------------------------------------------------------------+ *)
+
+exception Invalid_signature of string * string
+
+let () =
+  Printexc.register_printer
+    (function
+       | Invalid_signature(str, msg) ->
+           Some(Printf.sprintf "invalid signature %S: %s" str msg)
+       | _ ->
+           None)
+
+let invalid_signature str msg = raise (Invalid_signature(str, msg))
+
+let length_validate_signature l =
+  let rec aux_single length depth_struct depth_array depth_dict_entry = function
+    | T.Basic _ | T.Variant ->
+        length + 1
+    | T.Array t ->
+        if depth_array > OBus_protocol.max_type_recursion_depth then
+          failwith "too many nested arrays"
+        else
+          aux_single (length + 1) depth_struct (depth_array + 1) depth_dict_entry t
+    | T.Dict(tk, tv) ->
+        if depth_array > OBus_protocol.max_type_recursion_depth then
+          failwith "too many nested arrays"
+        else if depth_dict_entry > OBus_protocol.max_type_recursion_depth then
+          failwith "too many nested dict-entries"
+        else
+          aux_single (length + 4) depth_struct (depth_array + 1) (depth_dict_entry + 1) tv
+    | T.Structure [] ->
+        failwith "empty struct"
+    | T.Structure tl ->
+        if depth_struct > OBus_protocol.max_type_recursion_depth then
+          failwith "too many nested structs"
+        else
+          aux_sequence (length + 2) (depth_struct + 1) depth_array depth_dict_entry tl
+
+  and aux_sequence length depth_struct depth_array depth_dict_entry = function
+    | [] ->
+        if length > 255 then
+          failwith "signature too long"
+        else
+          length
+    | t :: tl ->
+        aux_sequence (aux_single length depth_struct depth_array depth_dict_entry t)
+          depth_struct depth_array depth_dict_entry tl
+  in
+  let _ : int = aux_sequence 0 0 0 0 l in
+  ()
+
+let signature_length l =
+  let rec aux_single length = function
+    | T.Basic _ | T.Variant ->
+        length + 1
+    | T.Array t ->
+        aux_single (length + 1) t
+    | T.Dict(tk, tv) ->
+        aux_single (length + 4) tv
+    | T.Structure tl ->
+        aux_sequence (length + 2) tl
+  and aux_sequence length = function
+    | [] ->
+        length
+    | t :: tl ->
+        aux_sequence (aux_single length t) tl
+  in
+  aux_sequence 0 l
+
+let validate_signature l =
+  try
+    length_validate_signature l;
+    None
+  with Failure msg ->
+    Some msg
+
+(* +-----------------------------------------------------------------+
+   | Signature reading |
+   +-----------------------------------------------------------------+ *)
+
+let signature_of_string str =
+  let len = String.length str and i = ref 0 in
+  let fail fmt = Printf.ksprintf (invalid_signature str) fmt in
+  let get_char () =
+    let j = !i in
+    if j = len then
+      fail "premature end of signature"
+    else begin
+      i := j + 1;
+      String.unsafe_get str j
+    end
+  in
+  let parse_basic msg = function
+    | 'y' -> T.Byte
+    | 'b' -> T.Boolean
+    | 'n' -> T.Int16
+    | 'q' -> T.Uint16
+    | 'i' -> T.Int32
+    | 'u' -> T.Uint32
+    | 'x' -> T.Int64
+    | 't' -> T.Uint64
+    | 'd' -> T.Double
+    | 's' -> T.String
+    | 'o' -> T.Object_path
+    | 'g' -> T.Signature
+    | 'h' -> T.Unix_fd
+    | chr -> fail msg chr
+  in
+
+  let rec parse_single = function
+    | 'a' -> begin
+        match get_char () with
+          | '{' ->
+              let tk = parse_basic "invalid basic type code: %c" (get_char ()) in
+              let tv = parse_single (get_char ()) in
+              begin match get_char () with
+                | '}' -> T.Dict(tk, tv)
+                | _ -> fail "'}' missing"
+              end
+          | ch ->
+              T.Array(parse_single ch)
+      end
+    | '(' ->
+        T.Structure (parse_struct (get_char ()))
+    | ')' ->
+        fail "')' without '('"
+    | 'v' ->
+        T.Variant
+    | ch ->
+        T.Basic(parse_basic "invalid type code: %c" ch);
+
+  and parse_struct = function
+    | ')' ->
+        []
+    | ch ->
+        let t = parse_single ch in
+        let l = parse_struct (get_char ()) in
+        t :: l
+  in
+
+  let rec read_sequence () =
+    if !i = len then
+      []
+    else
+      let t = parse_single (get_char ()) in
+      let l = read_sequence () in
+      t :: l
+  in
+  let s = read_sequence () in
+  match validate_signature s with
+    | Some msg ->
+        invalid_signature str msg
+    | None ->
+        s
+(* +-----------------------------------------------------------------+
+   | Signature writing |
+   +-----------------------------------------------------------------+ *)
+
+let string_of_signature signature =
+  let len = signature_length signature in
+  let str = Bytes.create len and i = ref 0 in
+  let put_char ch =
+    let j = !i in
+    Bytes.unsafe_set str j ch;
+    i := j + 1
+  in
+  let write_basic t =
+    put_char (match t with
+                | T.Byte -> 'y'
+                | T.Boolean -> 'b'
+                | T.Int16 -> 'n'
+                | T.Uint16 -> 'q'
+                | T.Int32 -> 'i'
+                | T.Uint32 -> 'u'
+                | T.Int64 -> 'x'
+                | T.Uint64 -> 't'
+                | T.Double -> 'd'
+                | T.String -> 's'
+                | T.Object_path -> 'o'
+                | T.Signature -> 'g'
+                | T.Unix_fd -> 'h')
+  in
+  let rec write_single = function
+    | T.Basic t ->
+        write_basic t
+    | T.Array t ->
+        put_char 'a';
+        write_single t
+    | T.Dict(tk, tv) ->
+        put_char 'a';
+        put_char '{';
+        write_basic tk;
+        write_single tv;
+        put_char '}'
+    | T.Structure tl ->
+        put_char '(';
+        List.iter write_single tl;
+        put_char ')'
+    | T.Variant ->
+        put_char 'v'
+  in
+  List.iter write_single signature;
+  let str = Bytes.unsafe_to_string str in
+  try
+    length_validate_signature signature;
+    str
+  with Failure msg ->
+    raise (Invalid_signature(str, msg))
+
+module V =
+struct
+
+  (* +---------------------------------------------------------------+
+     | D-Bus value definitions |
+     +---------------------------------------------------------------+ *)
+
+  type basic =
+    | Byte of char
+    | Boolean of bool
+    | Int16 of int
+    | Int32 of int32
+    | Int64 of int64
+    | Uint16 of int
+    | Uint32 of int32
+    | Uint64 of int64
+    | Double of float
+    | String of string
+    | Signature of signature
+    | Object_path of OBus_path.t
+    | Unix_fd of Unix.file_descr
+
+  type single =
+    | Basic of basic
+    | Array of T.single * single list
+    | Byte_array of string
+    | Dict of T.basic * T.single * (basic * single) list
+    | Structure of single list
+    | Variant of single
+
+  type sequence = single list
+
+  let byte x = Byte x
+  let boolean x = Boolean x
+  let int16 x = Int16 x
+  let int32 x = Int32 x
+  let int64 x = Int64 x
+  let uint16 x = Uint16 x
+  let uint32 x = Uint32 x
+  let uint64 x = Uint64 x
+  let double x = Double x
+  let string x = String x
+  let signature x = Signature x
+  let object_path x = Object_path x
+  let unix_fd x = Unix_fd x
+
+  let basic_byte x = Basic(Byte x)
+  let basic_boolean x = Basic(Boolean x)
+  let basic_int16 x = Basic(Int16 x)
+  let basic_int32 x = Basic(Int32 x)
+  let basic_int64 x = Basic(Int64 x)
+  let basic_uint16 x = Basic(Uint16 x)
+  let basic_uint32 x = Basic(Uint32 x)
+  let basic_uint64 x = Basic(Uint64 x)
+  let basic_double x = Basic(Double x)
+  let basic_string x = Basic(String x)
+  let basic_signature x = Basic(Signature x)
+  let basic_object_path x = Basic(Object_path x)
+  let basic_unix_fd x = Basic(Unix_fd x)
+
+  let basic x = Basic x
+  let byte_array x = Byte_array x
+  let structure x = Structure x
+  let variant x = Variant x
+
+  (* +---------------------------------------------------------------+
+     | Value typing |
+     +---------------------------------------------------------------+ *)
+
+  let type_of_basic = function
+    | Byte _ -> T.Byte
+    | Boolean _ -> T.Boolean
+    | Int16 _ -> T.Int16
+    | Int32 _ -> T.Int32
+    | Int64 _ -> T.Int64
+    | Uint16 _ -> T.Uint16
+    | Uint32 _ -> T.Uint32
+    | Uint64 _ -> T.Uint64
+    | Double _ -> T.Double
+    | String _ -> T.String
+    | Signature _ -> T.Signature
+    | Object_path _ -> T.Object_path
+    | Unix_fd _ -> T.Unix_fd
+
+  let rec type_of_single = function
+    | Basic x -> T.Basic(type_of_basic x)
+    | Array(t, x) -> T.Array t
+    | Byte_array x -> T.Array(T.Basic T.Byte)
+    | Dict(tk, tv, x) -> T.Dict(tk, tv)
+    | Structure x -> T.Structure(List.map type_of_single x)
+    | Variant _ -> T.Variant
+
+  let type_of_sequence = List.map type_of_single
+
+  let array t l =
+    if t = T.Basic T.Byte then begin
+      let s = Bytes.create (List.length l) and i = ref 0 in
+      List.iter (function
+                   | Basic(Byte x) ->
+                       Bytes.unsafe_set s !i x;
+                       incr i
+                   | _ ->
+                       invalid_arg "OBus_value.array: unexpected type") l;
+      Byte_array (Bytes.unsafe_to_string s)
+    end else begin
+      List.iter (fun x ->
+                   if type_of_single x <> t then
+                     invalid_arg "OBus_value.array: unexpected type") l;
+      Array(t, l)
+    end
+
+  let dict tk tv l =
+    List.iter (fun (k, v) ->
+                 if type_of_basic k <> tk || type_of_single v <> tv then
+                   invalid_arg "OBus_value.dict: unexpected type") l;
+    Dict(tk, tv, l)
+
+  let unsafe_array t l =
+    if t = T.Basic T.Byte then
+      array t l
+    else
+      Array(t, l)
+
+  let unsafe_dict tk tv l =
+    Dict(tk, tv, l)
+
+  (* +---------------------------------------------------------------+
+     | Value pretty-printing |
+     +---------------------------------------------------------------+ *)
+
+  let print_basic pp = function
+    | Byte x -> fprintf pp "%C" x
+    | Boolean x -> fprintf pp "%B" x
+    | Int16 x -> fprintf pp "%d" x
+    | Int32 x -> fprintf pp "%ldl" x
+    | Int64 x -> fprintf pp "%LdL" x
+    | Uint16 x -> fprintf pp "%d" x
+    | Uint32 x -> fprintf pp "%ldl" x
+    | Uint64 x -> fprintf pp "%LdL" x
+    | Double x -> fprintf pp "%f" x
+    | String x -> fprintf pp "%S" x
+    | Signature x -> T.print_sequence pp x
+    | Object_path x -> print_list (fun pp elt -> fprintf pp "%S" elt) pp x
+    | Unix_fd x -> pp_print_string pp "<fd>"
+
+  let explode str =
+    let rec aux acc = function
+      | -1 -> acc
+      | i -> aux (Basic(Byte(String.unsafe_get str i)) :: acc) (i - 1)
+    in
+    aux [] (String.length str - 1)
+
+  let rec print_single pp = function
+    | Basic v -> print_basic pp v
+    | Array(t, l) -> print_list print_single pp l
+    | Byte_array s -> print_single pp (Array(T.Basic T.Byte, explode s))
+    | Dict(tk, tv, l) -> print_list (fun pp (k, v) -> fprintf pp "(@[%a,@ %a@])" print_basic k print_single v) pp l
+    | Structure l -> print_sequence pp l
+    | Variant x -> fprintf pp "@[<2>Variant@,(@[<hv>%a,@ %a@])@]" T.print_single (type_of_single x) print_single x
+
+  and print_sequence pp l = print_tuple print_single pp l
+
+  let string_of_basic = string_of print_basic
+  let string_of_single = string_of print_single
+  let string_of_sequence = string_of print_sequence
+
+  (* +---------------------------------------------------------------+
+     | FDs closing |
+     +---------------------------------------------------------------+ *)
+
+  module FD_set = Set.Make(struct type t = Unix.file_descr let compare = compare end)
+
+  let basic_contains_fds = function
+    | T.Unix_fd -> true
+    | _ -> false
+
+  let rec single_contains_fds = function
+    | T.Basic t -> basic_contains_fds t
+    | T.Array t -> single_contains_fds t
+    | T.Dict(tk, tv) -> basic_contains_fds tk || single_contains_fds tv
+    | T.Structure t -> sequence_contains_fds t
+    | T.Variant -> true
+
+  and sequence_contains_fds t = List.exists single_contains_fds t
+
+  let basic_collect_fds acc = function
+    | Unix_fd fd -> FD_set .add fd acc
+    | _ -> acc
+
+  let rec single_collect_fds acc = function
+    | Basic v ->
+        basic_collect_fds acc v
+    | Array(t, l) ->
+        if single_contains_fds t then
+          List.fold_left single_collect_fds acc l
+        else
+          acc
+    | Dict(tk, tv, l) ->
+        if basic_contains_fds tk || single_contains_fds tv then
+          List.fold_left (fun acc (k, v) -> basic_collect_fds (single_collect_fds acc v) k) acc l
+        else
+          acc
+    | Structure l ->
+        sequence_collect_fds acc l
+    | Variant v ->
+        single_collect_fds acc v
+    | Byte_array _ ->
+        acc
+
+  and sequence_collect_fds acc l =
+    List.fold_left single_collect_fds acc l
+
+  let close_fds collect_fds value =
+    Lwt_list.iter_p
+      (fun fd ->
+         try
+           Lwt_unix.close (Lwt_unix.of_unix_file_descr ~set_flags:false fd)
+         with Unix.Unix_error(err, _, _) ->
+           Lwt_log.error_f ~section "failed to close file descriptor: %s" (Unix.error_message err))
+      (FD_set.elements (collect_fds FD_set.empty value))
+
+  let basic_close = close_fds basic_collect_fds
+  let single_close = close_fds single_collect_fds
+  let sequence_close = close_fds sequence_collect_fds
+
+  (* +---------------------------------------------------------------+
+     | FDs duplicating |
+     +---------------------------------------------------------------+ *)
+
+  module FD_map = Map.Make(struct type t = Unix.file_descr let compare = compare end)
+
+  let basic_dup map = function
+    | Unix_fd fd -> begin
+        try
+          Unix_fd(FD_map.find fd !map)
+        with Not_found ->
+          let fd' = Unix.dup fd in
+          map := FD_map.add fd fd' !map;
+          Unix_fd fd
+      end
+    | value ->
+        value
+
+  let rec single_dup map = function
+    | Basic x ->
+        basic (basic_dup map x)
+    | Array(t, l) as v ->
+        if single_contains_fds t then
+          array t (List.map (single_dup map) l)
+        else
+          v
+    | Dict(tk, tv, l) as v ->
+        if basic_contains_fds tk || single_contains_fds tv then
+          dict tk tv (List.map (fun (k, v) -> (basic_dup map k, single_dup map v)) l)
+        else
+          v
+    | Structure l ->
+        structure (sequence_dup map l)
+    | Byte_array _ as v ->
+        v
+    | Variant x ->
+        variant (single_dup map x)
+
+  and sequence_dup map l =
+    List.map (single_dup map) l
+
+  let basic_dup value = basic_dup (ref FD_map.empty) value
+  let single_dup value = single_dup (ref FD_map.empty) value
+  let sequence_dup value = sequence_dup (ref FD_map.empty) value
+end
+
+module C =
+struct
+
+  (* +---------------------------------------------------------------+
+     | Type combinators |
+     +---------------------------------------------------------------+ *)
+
+  exception Signature_mismatch
+
+  type 'a basic = {
+    basic_type : T.basic;
+    basic_make : 'a -> V.basic;
+    basic_cast : V.basic -> 'a;
+  }
+
+  type 'a single = {
+    single_type : T.single;
+    single_make : 'a -> V.single;
+    single_cast : V.single -> 'a;
+  }
+
+  type 'a sequence = {
+    sequence_type : T.sequence;
+    sequence_make : 'a -> V.sequence;
+    sequence_cast : V.sequence -> 'a;
+  }
+
+  let type_basic t = t.basic_type
+  let type_single t = t.single_type
+  let type_sequence t = t.sequence_type
+
+  let make_basic t x = t.basic_make x
+  let make_single t x = t.single_make x
+  let make_sequence t x = t.sequence_make x
+
+  let cast_basic t x = t.basic_cast x
+  let cast_single t x = t.single_cast x
+  let cast_sequence t x = t.sequence_cast x
+
+  let dyn_basic t = {
+    basic_type = t;
+    basic_make =
+      (fun x ->
+         if V.type_of_basic x <> t then
+           failwith "OBus_value.dyn_basic: types mismatach"
+         else
+           x);
+    basic_cast =
+      (fun x ->
+         if V.type_of_basic x <> t then
+           raise Signature_mismatch
+         else
+           x);
+  }
+
+  let dyn_single t = {
+    single_type = t;
+    single_make =
+      (fun x ->
+         if V.type_of_single x <> t then
+           failwith "OBus_value.dyn_single: types mismatach"
+         else
+           x);
+    single_cast =
+      (fun x ->
+         if V.type_of_single x <> t then
+           raise Signature_mismatch
+         else
+           x);
+  }
+
+  let dyn_sequence t = {
+    sequence_type = t;
+    sequence_make =
+      (fun x ->
+         if V.type_of_sequence x <> t then
+           failwith "OBus_value.dyn_sequence: types mismatach"
+         else
+           x);
+    sequence_cast =
+      (fun x ->
+         if V.type_of_sequence x <> t then
+           raise Signature_mismatch
+         else
+           x);
+  }
+
+  let byte = {
+    basic_type = T.Byte;
+    basic_make = V.byte;
+    basic_cast = (function
+                    | V.Byte x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_byte = {
+    single_type = T.basic_byte;
+    single_make = V.basic_byte;
+    single_cast = (function
+                     | V.Basic(V.Byte x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let boolean = {
+    basic_type = T.Boolean;
+    basic_make = V.boolean;
+    basic_cast = (function
+                    | V.Boolean x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_boolean = {
+    single_type = T.basic_boolean;
+    single_make = V.basic_boolean;
+    single_cast = (function
+                     | V.Basic(V.Boolean x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let int16 = {
+    basic_type = T.Int16;
+    basic_make = V.int16;
+    basic_cast = (function
+                    | V.Int16 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_int16 = {
+    single_type = T.basic_int16;
+    single_make = V.basic_int16;
+    single_cast = (function
+                     | V.Basic(V.Int16 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let int32 = {
+    basic_type = T.Int32;
+    basic_make = V.int32;
+    basic_cast = (function
+                    | V.Int32 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_int32 = {
+    single_type = T.basic_int32;
+    single_make = V.basic_int32;
+    single_cast = (function
+                     | V.Basic(V.Int32 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let int64 = {
+    basic_type = T.Int64;
+    basic_make = V.int64;
+    basic_cast = (function
+                    | V.Int64 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_int64 = {
+    single_type = T.basic_int64;
+    single_make = V.basic_int64;
+    single_cast = (function
+                     | V.Basic(V.Int64 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let uint16 = {
+    basic_type = T.Uint16;
+    basic_make = V.uint16;
+    basic_cast = (function
+                    | V.Uint16 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_uint16 = {
+    single_type = T.basic_uint16;
+    single_make = V.basic_uint16;
+    single_cast = (function
+                     | V.Basic(V.Uint16 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let uint32 = {
+    basic_type = T.Uint32;
+    basic_make = V.uint32;
+    basic_cast = (function
+                    | V.Uint32 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_uint32 = {
+    single_type = T.basic_uint32;
+    single_make = V.basic_uint32;
+    single_cast = (function
+                     | V.Basic(V.Uint32 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let uint64 = {
+    basic_type = T.Uint64;
+    basic_make = V.uint64;
+    basic_cast = (function
+                    | V.Uint64 x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_uint64 = {
+    single_type = T.basic_uint64;
+    single_make = V.basic_uint64;
+    single_cast = (function
+                     | V.Basic(V.Uint64 x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let double = {
+    basic_type = T.Double;
+    basic_make = V.double;
+    basic_cast = (function
+                    | V.Double x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_double = {
+    single_type = T.basic_double;
+    single_make = V.basic_double;
+    single_cast = (function
+                     | V.Basic(V.Double x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let string = {
+    basic_type = T.String;
+    basic_make = V.string;
+    basic_cast = (function
+                    | V.String x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_string = {
+    single_type = T.basic_string;
+    single_make = V.basic_string;
+    single_cast = (function
+                     | V.Basic(V.String x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let signature = {
+    basic_type = T.Signature;
+    basic_make = V.signature;
+    basic_cast = (function
+                    | V.Signature x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_signature = {
+    single_type = T.basic_signature;
+    single_make = V.basic_signature;
+    single_cast = (function
+                     | V.Basic(V.Signature x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let object_path = {
+    basic_type = T.Object_path;
+    basic_make = V.object_path;
+    basic_cast = (function
+                    | V.Object_path x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_object_path = {
+    single_type = T.basic_object_path;
+    single_make = V.basic_object_path;
+    single_cast = (function
+                     | V.Basic(V.Object_path x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let unix_fd = {
+    basic_type = T.Unix_fd;
+    basic_make = V.unix_fd;
+    basic_cast = (function
+                    | V.Unix_fd x -> x
+                    | _ -> raise Signature_mismatch);
+  }
+
+  let basic_unix_fd = {
+    single_type = T.basic_unix_fd;
+    single_make = V.basic_unix_fd;
+    single_cast = (function
+                     | V.Basic(V.Unix_fd x) -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let basic t = {
+    single_type = T.Basic t.basic_type;
+    single_make = (fun x -> V.Basic(t.basic_make x));
+    single_cast = (function
+                     | V.Basic x -> t.basic_cast x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let structure t = {
+    single_type = T.Structure t.sequence_type;
+    single_make = (fun x -> V.Structure(t.sequence_make x));
+    single_cast = (function
+                     | V.Structure x -> t.sequence_cast x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let byte_array = {
+    single_type = T.Array T.basic_byte;
+    single_make = V.byte_array;
+    single_cast = (function
+                     | V.Byte_array x -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let array t = {
+    single_type = T.Array t.single_type;
+    single_make = (fun x -> V.Array(t.single_type, List.map t.single_make x));
+    single_cast = (function
+                     | V.Array(t', x) when t.single_type = t' ->
+                         List.map t.single_cast x
+                     | V.Byte_array s when t.single_type = T.basic_byte ->
+                         let rec aux acc = function
+                           | -1 -> acc
+                           | i -> aux (t.single_cast (V.basic_byte (String.unsafe_get s i)) :: acc) (i - 1)
+                         in
+                         aux [] (String.length s - 1)
+                     | _ ->
+                         raise Signature_mismatch);
+  }
+
+  let dict tk tv = {
+    single_type = T.Dict(tk.basic_type, tv.single_type);
+    single_make = (fun x -> V.Dict(tk.basic_type, tv.single_type, List.map (fun (k, v) -> (tk.basic_make k, tv.single_make v)) x));
+    single_cast = (function
+                     | V.Dict(tk', tv', x) when tk.basic_type = tk' && tv.single_type = tv' ->
+                         List.map (fun (k, v) -> (tk.basic_cast k, tv.single_cast v)) x
+                     | _ ->
+                         raise Signature_mismatch);
+  }
+
+  let variant = {
+    single_type = T.Variant;
+    single_make = (fun x -> V.Variant x);
+    single_cast = (function
+                     | V.Variant x -> x
+                     | _ -> raise Signature_mismatch);
+  }
+
+  let seq_cons t tl = {
+    sequence_type = t.single_type :: tl.sequence_type;
+    sequence_make = (fun (x, l) -> t.single_make x :: tl.sequence_make l);
+    sequence_cast = (function
+                       | x :: l -> (t.single_cast x, tl.sequence_cast l)
+                       | [] -> raise Signature_mismatch);
+  }
+
+  let seq0 = {
+    sequence_type = [];
+    sequence_make = (fun () -> []);
+    sequence_cast = (function
+                       | [] -> ()
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq1 t1 = {
+    sequence_type = [t1.single_type];
+    sequence_make = (fun x1 -> [t1.single_make x1]);
+    sequence_cast = (function
+                       | [x1] -> t1.single_cast x1
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq2 t1 t2 = {
+    sequence_type = [t1.single_type; t2.single_type];
+    sequence_make = (fun (x1, x2) -> [t1.single_make x1; t2.single_make x2]);
+    sequence_cast = (function
+                       | [x1; x2] -> (t1.single_cast x1, t2.single_cast x2)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq3 t1 t2 t3 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type];
+    sequence_make = (fun (x1, x2, x3) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3]);
+    sequence_cast = (function
+                       | [x1; x2; x3] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq4 t1 t2 t3 t4 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type];
+    sequence_make = (fun (x1, x2, x3, x4) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq5 t1 t2 t3 t4 t5 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq6 t1 t2 t3 t4 t5 t6 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq7 t1 t2 t3 t4 t5 t6 t7 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq8 t1 t2 t3 t4 t5 t6 t7 t8 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq9 t1 t2 t3 t4 t5 t6 t7 t8 t9 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq10 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq11 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq12 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type; t12.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11; t12.single_make x12]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11, t12.single_cast x12)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq13 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type; t12.single_type; t13.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11; t12.single_make x12; t13.single_make x13]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12; x13] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11, t12.single_cast x12, t13.single_cast x13)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq14 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type; t12.single_type; t13.single_type; t14.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11; t12.single_make x12; t13.single_make x13; t14.single_make x14]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12; x13; x14] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11, t12.single_cast x12, t13.single_cast x13, t14.single_cast x14)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq15 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type; t12.single_type; t13.single_type; t14.single_type; t15.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11; t12.single_make x12; t13.single_make x13; t14.single_make x14; t15.single_make x15]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12; x13; x14; x15] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11, t12.single_cast x12, t13.single_cast x13, t14.single_cast x14, t15.single_cast x15)
+                       | _ -> raise Signature_mismatch);
+  }
+  let seq16 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 = {
+    sequence_type = [t1.single_type; t2.single_type; t3.single_type; t4.single_type; t5.single_type; t6.single_type; t7.single_type; t8.single_type; t9.single_type; t10.single_type; t11.single_type; t12.single_type; t13.single_type; t14.single_type; t15.single_type; t16.single_type];
+    sequence_make = (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16) -> [t1.single_make x1; t2.single_make x2; t3.single_make x3; t4.single_make x4; t5.single_make x5; t6.single_make x6; t7.single_make x7; t8.single_make x8; t9.single_make x9; t10.single_make x10; t11.single_make x11; t12.single_make x12; t13.single_make x13; t14.single_make x14; t15.single_make x15; t16.single_make x16]);
+    sequence_cast = (function
+                       | [x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12; x13; x14; x15; x16] -> (t1.single_cast x1, t2.single_cast x2, t3.single_cast x3, t4.single_cast x4, t5.single_cast x5, t6.single_cast x6, t7.single_cast x7, t8.single_cast x8, t9.single_cast x9, t10.single_cast x10, t11.single_cast x11, t12.single_cast x12, t13.single_cast x13, t14.single_cast x14, t15.single_cast x15, t16.single_cast x16)
+                       | _ -> raise Signature_mismatch);
+  }
+end
+
+(* +-----------------------------------------------------------------+
+   | Arguments                                                       |
+   +-----------------------------------------------------------------+ *)
+
+open C
+
+type 'a arguments = {
+  arg_types : 'a C.sequence;
+  arg_names : string option list;
+}
+
+let arguments ~arg_types ~arg_names =
+  if List.length arg_types.C.sequence_type = List.length arg_names then
+    {
+      arg_types = arg_types;
+      arg_names = arg_names;
+    }
+  else
+    invalid_arg "OBus_value.arguments"
+
+let arg_types t = t.arg_types
+let arg_names t = t.arg_names
+
+let arg_cons (name, t) args = {
+  arg_types = seq_cons t args.arg_types;
+  arg_names = name :: args.arg_names;
+}
+
+let arg0 = {
+  arg_types = seq0;
+  arg_names = [];
+}
+let arg1 (n1, t1) = {
+  arg_types = seq1 t1;
+  arg_names = [n1];
+}
+let arg2 (n1, t1) (n2, t2) = {
+  arg_types = seq2 t1 t2;
+  arg_names = [n1; n2];
+}
+let arg3 (n1, t1) (n2, t2) (n3, t3) = {
+  arg_types = seq3 t1 t2 t3;
+  arg_names = [n1; n2; n3];
+}
+let arg4 (n1, t1) (n2, t2) (n3, t3) (n4, t4) = {
+  arg_types = seq4 t1 t2 t3 t4;
+  arg_names = [n1; n2; n3; n4];
+}
+let arg5 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) = {
+  arg_types = seq5 t1 t2 t3 t4 t5;
+  arg_names = [n1; n2; n3; n4; n5];
+}
+let arg6 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) = {
+  arg_types = seq6 t1 t2 t3 t4 t5 t6;
+  arg_names = [n1; n2; n3; n4; n5; n6];
+}
+let arg7 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) = {
+  arg_types = seq7 t1 t2 t3 t4 t5 t6 t7;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7];
+}
+let arg8 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) = {
+  arg_types = seq8 t1 t2 t3 t4 t5 t6 t7 t8;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8];
+}
+let arg9 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) = {
+  arg_types = seq9 t1 t2 t3 t4 t5 t6 t7 t8 t9;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9];
+}
+let arg10 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) = {
+  arg_types = seq10 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10];
+}
+let arg11 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) = {
+  arg_types = seq11 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11];
+}
+let arg12 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) (n12, t12) = {
+  arg_types = seq12 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11; n12];
+}
+let arg13 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) (n12, t12) (n13, t13) = {
+  arg_types = seq13 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11; n12; n13];
+}
+let arg14 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) (n12, t12) (n13, t13) (n14, t14) = {
+  arg_types = seq14 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11; n12; n13; n14];
+}
+let arg15 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) (n12, t12) (n13, t13) (n14, t14) (n15, t15) = {
+  arg_types = seq15 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11; n12; n13; n14; n15];
+}
+let arg16 (n1, t1) (n2, t2) (n3, t3) (n4, t4) (n5, t5) (n6, t6) (n7, t7) (n8, t8) (n9, t9) (n10, t10) (n11, t11) (n12, t12) (n13, t13) (n14, t14) (n15, t15) (n16, t16) = {
+  arg_types = seq16 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16;
+  arg_names = [n1; n2; n3; n4; n5; n6; n7; n8; n9; n10; n11; n12; n13; n14; n15; n16];
+}
+
diff --git a/src/internals/oBus_value.mli b/src/internals/oBus_value.mli
new file mode 100644
index 0000000..5553725
--- /dev/null
+++ b/src/internals/oBus_value.mli
@@ -0,0 +1,369 @@
+(*
+ * oBus_value.mli
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus types, values and converters *)
+
+(** {6 Types} *)
+
+(** D-Bus types *)
+module T : sig
+
+  type basic =
+    | Byte
+    | Boolean
+    | Int16
+    | Int32
+    | Int64
+    | Uint16
+    | Uint32
+    | Uint64
+    | Double
+    | String
+    | Signature
+    | Object_path
+    | Unix_fd
+
+  type single =
+    | Basic of basic
+    | Structure of single list
+    | Array of single
+    | Dict of basic * single
+    | Variant
+
+  type sequence = single list
+
+  (** {6 Constructors} *)
+
+  val byte : basic
+  val boolean : basic
+  val int16 : basic
+  val int32 : basic
+  val int64 : basic
+  val uint16 : basic
+  val uint32 : basic
+  val uint64 : basic
+  val double : basic
+  val string : basic
+  val signature : basic
+  val object_path : basic
+  val unix_fd : basic
+
+  val basic : basic -> single
+  val structure : single list -> single
+  val array : single -> single
+  val dict : basic -> single -> single
+  val variant : single
+
+  val basic_byte : single
+  val basic_boolean : single
+  val basic_int16 : single
+  val basic_int32 : single
+  val basic_int64 : single
+  val basic_uint16 : single
+  val basic_uint32 : single
+  val basic_uint64 : single
+  val basic_double : single
+  val basic_string : single
+  val basic_signature : single
+  val basic_object_path : single
+  val basic_unix_fd : single
+
+  (** {6 Pretty printing} *)
+
+  val print_basic : Format.formatter -> basic -> unit
+  val print_single : Format.formatter -> single -> unit
+  val print_sequence : Format.formatter -> sequence -> unit
+
+  val string_of_basic : basic -> string
+  val string_of_single : single -> string
+  val string_of_sequence : sequence -> string
+end
+
+(** {6 Signatures} *)
+
+type signature = T.sequence
+
+exception Invalid_signature of string * string
+  (** [Invalid_signature(signature, message)] is raised when a
+      signature is invalid. [signature] is a string representation of
+      the signature (using D-Bus type codes) and [message] is an error
+      message. *)
+
+val string_of_signature : signature -> string
+  (** Returns a string representation of a signature using D-Bus type
+      codes. If the signature is not valid (for example it is too
+      long), it raises {!Invalid_signature}. *)
+
+val signature_of_string : string -> signature
+  (** Parses a signature. Raises {!Invalid_signature} if the signature
+      is not correct *)
+
+val validate_signature : signature -> string option
+  (** Not all signatures are valid. [validate] returns [None] if the
+      given signature is a valid one, or [Some reason] if it is
+      not. *)
+
+(** {6 Values} *)
+
+(** D-Bus values *)
+module V : sig
+
+  type basic =
+    | Byte of char
+    | Boolean of bool
+    | Int16 of int
+    | Int32 of int32
+    | Int64 of int64
+    | Uint16 of int
+    | Uint32 of int32
+    | Uint64 of int64
+    | Double of float
+    | String of string
+    | Signature of signature
+    | Object_path of OBus_path.t
+    | Unix_fd of Unix.file_descr
+
+  type single =
+      private
+    | Basic of basic
+    | Array of T.single * single list
+    | Byte_array of string
+    | Dict of T.basic * T.single * (basic * single) list
+    | Structure of single list
+    | Variant of single
+
+  type sequence = single list
+
+  (** {6 Constructors} *)
+
+  val byte : char -> basic
+  val boolean : bool -> basic
+  val int16 : int -> basic
+  val int32 : int32 -> basic
+  val int64 : int64 -> basic
+  val uint16 : int -> basic
+  val uint32 : int32 -> basic
+  val uint64 : int64 -> basic
+  val double : float -> basic
+  val string : string -> basic
+  val signature : signature -> basic
+  val object_path : OBus_path.t -> basic
+  val unix_fd : Unix.file_descr -> basic
+
+  val basic : basic -> single
+  val array : T.single -> single list -> single
+  val byte_array : string -> single
+  val dict : T.basic -> T.single -> (basic * single) list -> single
+  val structure : single list -> single
+  val variant : single -> single
+
+  (**/**)
+
+  val unsafe_array : T.single -> single list -> single
+  val unsafe_dict : T.basic -> T.single -> (basic * single) list -> single
+
+  (**/**)
+
+  val basic_byte : char -> single
+  val basic_boolean : bool -> single
+  val basic_int16 : int -> single
+  val basic_int32 : int32 -> single
+  val basic_int64 : int64 -> single
+  val basic_uint16 : int -> single
+  val basic_uint32 : int32 -> single
+  val basic_uint64 : int64 -> single
+  val basic_double : float -> single
+  val basic_string : string -> single
+  val basic_signature : signature -> single
+  val basic_object_path : OBus_path.t -> single
+  val basic_unix_fd : Unix.file_descr -> single
+
+  (** {6 Typing} *)
+
+  val type_of_basic : basic -> T.basic
+  val type_of_single : single -> T.single
+  val type_of_sequence : sequence -> T.sequence
+
+  (** {6 Pretty printing} *)
+
+  val print_basic : Format.formatter -> basic -> unit
+  val print_single : Format.formatter -> single -> unit
+  val print_sequence : Format.formatter -> sequence -> unit
+
+  val string_of_basic : basic -> string
+  val string_of_single : single -> string
+  val string_of_sequence : sequence -> string
+
+  (** {6 File descriptors utils} *)
+
+  val basic_dup : basic -> basic
+  val single_dup : single -> single
+  val sequence_dup : sequence -> sequence
+    (** Duplicates all file descriptors of the given value *)
+
+  val basic_close : basic -> unit Lwt.t
+  val single_close : single -> unit Lwt.t
+  val sequence_close : sequence -> unit Lwt.t
+    (** Closes all file descriptors of the given value *)
+end
+
+(** {6 Type converters} *)
+
+(** Type converters *)
+module C : sig
+
+  (** This module offers a convenient way of constructing a boxed D-Bus
+      value from a OCaml value, and of casting a boxed D-Bus value
+      into a OCaml value. *)
+
+  type 'a basic
+    (** Type of converters dealing with basic D-Bus types *)
+
+  type 'a single
+    (** Type of converters dealing with single D-Bus types *)
+
+  type 'a sequence
+    (** Type of converters dealing with sequence D-Bus types *)
+
+  (** {6 Constructors} *)
+
+  val byte : char basic
+  val boolean : bool basic
+  val int16 : int basic
+  val int32 : int32 basic
+  val int64 : int64 basic
+  val uint16 : int basic
+  val uint32 : int32 basic
+  val uint64 : int64 basic
+  val double : float basic
+  val string : string basic
+  val signature : signature basic
+  val object_path : OBus_path.t basic
+  val unix_fd : Unix.file_descr basic
+
+  val basic : 'a basic -> 'a single
+  val structure : 'a sequence -> 'a single
+  val byte_array : string single
+  val array : 'a single -> 'a list single
+  val dict : 'a basic -> 'b single -> ('a * 'b) list single
+  val variant : V.single single
+
+  val basic_byte : char single
+  val basic_boolean : bool single
+  val basic_int16 : int single
+  val basic_int32 : int32 single
+  val basic_int64 : int64 single
+  val basic_uint16 : int single
+  val basic_uint32 : int32 single
+  val basic_uint64 : int64 single
+  val basic_double : float single
+  val basic_string : string single
+  val basic_signature : signature single
+  val basic_object_path : OBus_path.t single
+  val basic_unix_fd : Unix.file_descr single
+
+  (** {6 Types extraction} *)
+
+  val type_basic : 'a basic -> T.basic
+  val type_single : 'a single -> T.single
+  val type_sequence : 'a sequence -> T.sequence
+
+  (** {6 Boxing} *)
+
+  val make_basic : 'a basic -> 'a -> V.basic
+  val make_single : 'a single -> 'a -> V.single
+  val make_sequence : 'a sequence -> 'a -> V.sequence
+
+  (**  {6 Unboxing} *)
+
+  exception Signature_mismatch
+    (** Exception raised when a boxed value do not have the same
+        signature as the combinator *)
+
+  val cast_basic : 'a basic -> V.basic -> 'a
+  val cast_single : 'a single -> V.single -> 'a
+  val cast_sequence : 'a sequence -> V.sequence -> 'a
+
+  (** {6 Dynamic values} *)
+
+  (** The follwing functions allows you to create converters that do
+      not convert values. *)
+
+  val dyn_basic : T.basic -> V.basic basic
+  val dyn_single : T.single -> V.single single
+  val dyn_sequence : T.sequence -> V.sequence sequence
+
+  (** {6 Sequence constructors} *)
+
+  val seq0 : unit sequence
+  val seq1 : 'a1 single -> 'a1 sequence
+  val seq2 : 'a1 single -> 'a2 single -> ('a1 * 'a2) sequence
+  val seq3 : 'a1 single -> 'a2 single -> 'a3 single -> ('a1 * 'a2 * 'a3) sequence
+  val seq4 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> ('a1 * 'a2 * 'a3 * 'a4) sequence
+  val seq5 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5) sequence
+  val seq6 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6) sequence
+  val seq7 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7) sequence
+  val seq8 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8) sequence
+  val seq9 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9) sequence
+  val seq10 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10) sequence
+  val seq11 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11) sequence
+  val seq12 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> 'a12 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12) sequence
+  val seq13 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> 'a12 single -> 'a13 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13) sequence
+  val seq14 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> 'a12 single -> 'a13 single -> 'a14 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14) sequence
+  val seq15 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> 'a12 single -> 'a13 single -> 'a14 single -> 'a15 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14 * 'a15) sequence
+  val seq16 : 'a1 single -> 'a2 single -> 'a3 single -> 'a4 single -> 'a5 single -> 'a6 single -> 'a7 single -> 'a8 single -> 'a9 single -> 'a10 single -> 'a11 single -> 'a12 single -> 'a13 single -> 'a14 single -> 'a15 single -> 'a16 single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14 * 'a15 * 'a16) sequence
+end
+
+(** {6 Methods/signals arguments} *)
+
+(** Type of a list of arguments used by methods and signals. It is
+    ensured that the number of single types contained in [arg_types]
+    is equal to the number of names. *)
+type 'a arguments = private {
+  arg_types : 'a C.sequence;
+  (** Types of the arguments *)
+  arg_names : string option list;
+  (** Names of the arguments *)
+}
+
+val arguments : arg_types : 'a C.sequence -> arg_names : string option list -> 'a arguments
+  (** [arguments ~arg_types ~arg_names] creates a list of
+      arguments. It raises [Invalid_arg] if the number of single types
+      contained in [arg_types] is not equal to the number of names. *)
+
+val arg_types : 'a arguments -> 'a C.sequence
+  (** Returns the underlying sequence converter of a list of
+      arguments. *)
+
+val arg_names : 'a arguments -> string option list
+  (** Returns the names of a list of arguments *)
+
+(** {8 Constructors} *)
+
+val arg_cons : string option * 'a C.single -> 'b arguments -> ('a * 'b) arguments
+  (** [arg_cons (name, typ) arguments] adds the argument [(name,
+      type)] to the beginning of [arguments] *)
+
+val arg0 : unit arguments
+val arg1 : string option * 'a1 C.single -> 'a1 arguments
+val arg2 : string option * 'a1 C.single -> string option * 'a2 C.single -> ('a1 * 'a2) arguments
+val arg3 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> ('a1 * 'a2 * 'a3) arguments
+val arg4 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> ('a1 * 'a2 * 'a3 * 'a4) arguments
+val arg5 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5) arguments
+val arg6 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6) arguments
+val arg7 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7) arguments
+val arg8 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8) arguments
+val arg9 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9) arguments
+val arg10 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10) arguments
+val arg11 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11) arguments
+val arg12 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> string option * 'a12 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12) arguments
+val arg13 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> string option * 'a12 C.single -> string option * 'a13 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13) arguments
+val arg14 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> string option * 'a12 C.single -> string option * 'a13 C.single -> string option * 'a14 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14) arguments
+val arg15 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> string option * 'a12 C.single -> string option * 'a13 C.single -> string option * 'a14 C.single -> string option * 'a15 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14 * 'a15) arguments
+val arg16 : string option * 'a1 C.single -> string option * 'a2 C.single -> string option * 'a3 C.single -> string option * 'a4 C.single -> string option * 'a5 C.single -> string option * 'a6 C.single -> string option * 'a7 C.single -> string option * 'a8 C.single -> string option * 'a9 C.single -> string option * 'a10 C.single -> string option * 'a11 C.single -> string option * 'a12 C.single -> string option * 'a13 C.single -> string option * 'a14 C.single -> string option * 'a15 C.single -> string option * 'a16 C.single -> ('a1 * 'a2 * 'a3 * 'a4 * 'a5 * 'a6 * 'a7 * 'a8 * 'a9 * 'a10 * 'a11 * 'a12 * 'a13 * 'a14 * 'a15 * 'a16) arguments
diff --git a/src/internals/oBus_xml_parser.ml b/src/internals/oBus_xml_parser.ml
new file mode 100644
index 0000000..25e3a58
--- /dev/null
+++ b/src/internals/oBus_xml_parser.ml
@@ -0,0 +1,191 @@
+(*
+ * oBus_xml_parser.ml
+ * ------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+
+exception Parse_failure of Xmlm.pos * string
+
+type xml =
+  | Element of Xmlm.pos * string * (string * string) list * xml list
+  | PCData of Xmlm.pos * string
+
+type node_type =
+  | NT_element of string
+  | NT_pcdata
+  | NT_any
+  | NT_union of node_type list
+
+type 'a node = node_type * (xml -> 'a option)
+
+type xml_parser = {
+  position : Xmlm.pos;
+  attributes : (string * string) list;
+  mutable children : xml list;
+}
+
+let failwith p msg = raise (Parse_failure(p.position, msg))
+
+let ao p name =
+  OBus_util.assoc name p.attributes
+
+let ar p name =
+  match ao p name with
+    | Some v -> v
+    | None -> ksprintf (failwith p)  "attribute '%s' missing" name
+
+let ad p name default =
+  match ao p name with
+    | Some v -> v
+    | None -> default
+
+let afo p name field =
+  match OBus_util.assoc name p.attributes with
+    | None ->
+        None
+    | Some v ->
+        match OBus_util.assoc v field with
+          | Some v ->
+              Some v
+          | None ->
+              ksprintf (failwith p)
+                "unexpected value for '%s' (%s), must be one of %s"
+                name v (String.concat ", " (List.map (fun (name, v) -> "'" ^ name ^ "'") field))
+
+let afr p name field =
+  match afo p name field with
+    | Some v -> v
+    | None -> ksprintf (failwith p)  "attribute '%s' missing" name
+
+let afd p name default field =
+  match afo p name field with
+    | Some v -> v
+    | None -> default
+
+let execute xml_parser p =
+  try
+    let result = xml_parser p in
+    match p.children with
+      | [] ->
+          result
+      | Element(pos, name, _, _) :: _ ->
+          ksprintf (failwith p) "unknown element '%s'" name
+      | PCData(pos, _) :: _ ->
+          failwith p "trailing pc-data"
+  with
+    | Parse_failure _ as exn ->
+        raise exn
+    | exn ->
+        failwith p (Printexc.to_string exn)
+
+let elt name elt_parser =
+  (NT_element name,
+   function
+     | Element(pos, name', attrs, children) when name = name' ->
+         Some(execute elt_parser { position = pos; children = children; attributes =  attrs})
+     | _ ->
+         None)
+
+let pcdata =
+  (NT_pcdata,
+   function
+     | Element _ -> None
+     | PCData(_, x) -> Some x)
+
+let union nodes =
+  let types, fl = List.split nodes in
+  (NT_union types, fun node -> OBus_util.find_map (fun f -> f node) fl)
+
+let map (typ, f) g = (typ, fun node -> OBus_util.map_option (f node) g)
+
+let string_of_type typ =
+  let rec flat acc = function
+    | NT_union l -> List.fold_left flat acc l
+    | NT_pcdata -> "<pcdata>" :: acc
+    | NT_any -> "<any>" :: acc
+    | NT_element name -> name :: acc
+  in
+  match flat [] typ with
+    | [] -> "<nothing>"
+    | [x] -> x
+    | l -> String.concat " or " l
+
+let opt p (typ, f) =
+  match OBus_util.part_map f p.children with
+    | [], rest ->
+        None
+    | [x], rest ->
+        p.children <- rest;
+        Some x
+    | _, rest ->
+        ksprintf (failwith p) "too many nodes of type %S" (string_of_type typ)
+
+let one p (typ, f) =
+  match opt p (typ, f) with
+    | Some x -> x
+    | None -> ksprintf (failwith p) "element missing: %S" (string_of_type typ)
+
+let any p (typ, f) =
+  let success, rest = OBus_util.part_map f p.children in
+  p.children <- rest;
+  success
+
+let pos_of_xml = function
+  | Element(pos, _, _, _) -> pos
+  | PCData(pos, _) -> pos
+
+let parse node xml =
+  execute (fun p -> one p node) { position = pos_of_xml xml; attributes = []; children = [xml] }
+
+let input input node =
+  let rec make () =
+    let pos = Xmlm.pos input in
+    match Xmlm.input input with
+      | `El_start(("", name), attrs) ->
+          Element(pos, name, List.map (fun ((uri, name), value) -> (name, value)) attrs, make_list ())
+      | `El_start((_, name), attrs) ->
+          (* Drops elements that are not part of the specification *)
+          drop 0;
+          make ()
+      | `El_end ->
+          raise (Parse_failure(pos, "unexpected end of element"))
+      | `Data str ->
+          PCData(pos, str)
+      | `Dtd _ ->
+          make ()
+  and make_list () =
+    let pos = Xmlm.pos input in
+    match Xmlm.input input with
+      | `El_start(("", name), attrs) ->
+          let xml = Element(pos, name, List.map (fun ((uri, name), value) -> (name, value)) attrs, make_list ()) in
+          xml :: make_list ()
+      | `El_start((_, name), attrs) ->
+          drop 0;
+          make_list ()
+      | `El_end ->
+          []
+      | `Data str ->
+          let xml = PCData(pos, str) in
+          xml :: make_list ()
+      | `Dtd _ ->
+          make_list ()
+  and drop deep =
+    match Xmlm.input input with
+      | `El_start _ ->
+          drop (deep + 1)
+      | `El_end ->
+          if deep <> 0 then drop (deep - 1)
+      | `Data str ->
+          drop deep
+      | `Dtd _ ->
+          drop deep
+  in
+  try
+    parse node (make ())
+  with Xmlm.Error(pos, error) ->
+    raise (Parse_failure(pos, Xmlm.error_message error))
diff --git a/src/internals/oBus_xml_parser.mli b/src/internals/oBus_xml_parser.mli
new file mode 100644
index 0000000..92aa460
--- /dev/null
+++ b/src/internals/oBus_xml_parser.mli
@@ -0,0 +1,85 @@
+(*
+ * oBus_xml_parser.mli
+ * -------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Monadic xml parsing *)
+
+(** This module implements a simple monadic xml parser.
+
+    It is intended to make it easy to write XML document parsers. In
+    OBus it is used to parse introspection document. *)
+
+exception Parse_failure of Xmlm.pos * string
+
+type xml_parser
+  (** Type of an xml parser. It is used to parse a sequence of
+      arguments and children of an element. *)
+
+type 'a node
+  (** Type of a single xml node parser, returning a value of type
+      ['a] *)
+
+val failwith : xml_parser -> string -> 'a
+  (** Fail at current position with the given error message *)
+
+val input : Xmlm.input -> 'a node -> 'a
+  (** Run a parser on a xml input. If it fails it raises a
+      [Parse_failure] *)
+
+(** {6 Parsing of attributes} *)
+
+(** For the following functions, the first argument is the attribute
+    name and each letter mean:
+
+    - [o] : the attribute is optionnal
+    - [r] : the attribute is required
+    - [d] : a default value is given
+    - [f] : a associative list  for the attribute value is specified. *)
+
+val ar : xml_parser -> string -> string
+val ao : xml_parser -> string -> string option
+val ad : xml_parser -> string -> string -> string
+val afr : xml_parser -> string -> (string * 'a) list -> 'a
+val afo : xml_parser -> string -> (string * 'a) list -> 'a option
+val afd : xml_parser -> string -> 'a -> (string * 'a) list -> 'a
+
+(** {6 Parsing of elements} *)
+
+val elt : string -> (xml_parser -> 'a) -> 'a node
+  (** [elt typ parser] creates a node parser. It will parse element of
+      type [typ]. [parser] is used to parse the attributes and
+      children of the element.
+
+      Note that [parser] must consume all children, if some are left
+      unparsed the parsing will fail. *)
+
+val pcdata : string node
+  (** [pcdata f] parse one PCData *)
+
+val map : 'a node -> ('a -> 'b) -> 'b node
+  (** [map node f] wraps the result of a node parser with [f] *)
+
+val union : 'a node list -> 'a node
+  (** [union nodes] Node parser which parses any node matched by one of
+      the given node parsers *)
+
+(** {6 Modifiers} *)
+
+val one : xml_parser -> 'a node -> 'a
+  (** [one node] parse exactly one node with the given node parser. It
+      will fail if there is 0 or more than one node matched by
+      [node]. *)
+
+val opt : xml_parser -> 'a node -> 'a option
+  (** same as [one] but do not fail if there is no node matched by
+      [node]. *)
+
+val any : xml_parser -> 'a node -> 'a list
+  (** [any node] Parse all element matched by [node]. The resulting
+      list is in the same order as the order in which nodes appears in
+      the xml. *)
diff --git a/src/ppx/dune b/src/ppx/dune
new file mode 100644
index 0000000..f410913
--- /dev/null
+++ b/src/ppx/dune
@@ -0,0 +1,7 @@
+(library
+ (name ppx_obus)
+ (public_name obus.ppx)
+ (kind ppx_rewriter)
+ (synopsis "Utility syntax for defining D-Bus errors")
+ (libraries ppxlib)
+ (preprocess (pps ppxlib.metaquot)))
diff --git a/src/ppx/ppx_obus.ml b/src/ppx/ppx_obus.ml
new file mode 100644
index 0000000..e07c3e3
--- /dev/null
+++ b/src/ppx/ppx_obus.ml
@@ -0,0 +1,74 @@
+open Ppxlib
+
+let rewriter_name = "ppx_obus"
+
+
+let find_attr_expr s attrs =
+  let expr_of_payload = function
+    | PStr [{ pstr_desc = Pstr_eval (e, _); _ }] -> Some e
+    | _ -> None in
+  try expr_of_payload (
+          let payload =
+            List.find (fun attr -> attr.attr_name.txt = s) attrs
+          in
+          payload.attr_payload)
+  with Not_found -> None
+
+
+let register_obus_exception = function
+  | { pstr_desc = Pstr_exception exn; pstr_loc } ->
+    (match find_attr_expr "obus" exn.ptyexn_attributes with
+    | Some expr ->
+      let registerer typ =
+        let loc = pstr_loc in
+        if Filename.basename pstr_loc.loc_start.pos_fname = "oBus_error.ml" then
+          [%stri
+            let () =
+              let module M =
+                Register(struct
+                  let name = [%e expr]
+                  exception E of [%t typ]
+                end)
+              in ()
+          ]
+        else
+          [%stri
+            let () =
+              let module M =
+                OBus_error.Register(struct
+                  let name = [%e expr]
+                  exception E of [%t typ]
+                end)
+              in ()
+          ] in
+      (match exn.ptyexn_constructor.pext_kind with
+      | Pext_decl (Pcstr_tuple [typ], None) ->
+          Some (registerer typ)
+      | _ ->
+        Location.raise_errorf ~loc:pstr_loc
+          "%s: OBus exceptions take a single string argument" rewriter_name)
+    | _ ->
+      None)
+  | _ ->
+    None
+
+
+let obus_mapper = object(self)
+  inherit Ast_traverse.map
+
+  method! structure items =
+    List.fold_right (fun item acc ->
+        let item' = self#structure_item item in
+        match register_obus_exception item with
+        | Some reg ->
+          item' :: reg :: acc
+        | None ->
+          item' :: acc)
+      items []
+end
+
+
+let () =
+  Driver.register_transformation
+    ~impl:(fun structure -> obus_mapper#structure structure)
+    rewriter_name
diff --git a/src/protocol/dune b/src/protocol/dune
new file mode 100644
index 0000000..a7a9ccc
--- /dev/null
+++ b/src/protocol/dune
@@ -0,0 +1,15 @@
+(library
+ (name obus)
+ (public_name obus)
+ (wrapped false)
+ (synopsis "Pure Ocaml implementation of the D-Bus protocol")
+ (libraries lwt.unix lwt_log lwt_react xmlm obus.internals)
+ (preprocess (pps lwt_ppx ppx_obus)))
+
+(ocamllex oBus_address_lexer oBus_match_rule_lexer)
+
+(rule
+ (targets oBus_interfaces.ml oBus_interfaces.mli)
+ (deps    oBus_interfaces.obus)
+ (action
+  (run obus-gen-interface -keep-common -o oBus_interfaces %{deps})))
diff --git a/src/protocol/oBus_address.ml b/src/protocol/oBus_address.ml
new file mode 100644
index 0000000..4d9f526
--- /dev/null
+++ b/src/protocol/oBus_address.ml
@@ -0,0 +1,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
+)
diff --git a/src/protocol/oBus_address.mli b/src/protocol/oBus_address.mli
new file mode 100644
index 0000000..9062b07
--- /dev/null
+++ b/src/protocol/oBus_address.mli
@@ -0,0 +1,71 @@
+(*
+ * oBus_address.mli
+ * ----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Manipulation of D-Bus addresses *)
+
+(** {6 Types} *)
+
+type guid = OBus_uuid.t
+    (** A unique address identifier. Each server's listening address
+        has a unique one. *)
+
+(** Type of an address *)
+type t = {
+  name : string;
+  (** The transport name *)
+
+  args : (string * string) list;
+  (** Arguments of the address *)
+}
+
+val name : t -> string
+  (** [name] projection *)
+
+val args : t -> (string * string) list
+  (** [args] Projection *)
+
+val make : name : string -> args : (string * string) list -> t
+  (** Creates an address *)
+
+val arg : string -> t -> string option
+  (** [arg key address] returns the value of argument [key], if any *)
+
+val guid : t -> guid option
+  (** Returns the address guid, if any *)
+
+(** {6 To/from string conversion} *)
+
+exception Parse_failure of string * int * string
+  (** [Parse_failure(string, position, reason)] exception raised when
+      parsing a string failed. *)
+
+val of_string : string -> t list
+  (** [of_string str] parse [str] and return the list of addresses
+      defined in it.
+
+      @raise Parse_failure if the string contains an invalid address
+  *)
+
+val to_string : t list -> string
+  (** [to_string addresses] return a string representation of a list
+      of addresses *)
+
+(** {6 Well-known addresses} *)
+
+val system : t list Lwt.t Lazy.t
+  (** The list of addresses for system bus *)
+
+val session : t list Lwt.t Lazy.t
+  (** The list of addresses for session bus *)
+
+val default_system : t list
+  (** The default addresses for the system bus *)
+
+val default_session : t list
+  (** The default addresses for the session bus *)
diff --git a/src/protocol/oBus_address_lexer.mll b/src/protocol/oBus_address_lexer.mll
new file mode 100644
index 0000000..db0a666
--- /dev/null
+++ b/src/protocol/oBus_address_lexer.mll
@@ -0,0 +1,106 @@
+(*
+ * oBus_address_lexer.mll
+ * ----------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+{
+  exception Fail of int * string
+
+  let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum
+
+  let fail lexbuf fmt =
+    Printf.ksprintf
+      (fun msg -> raise (Fail(pos lexbuf, msg)))
+      fmt
+}
+
+let name = [^ ':' ',' ';' '=']+
+
+rule addresses = parse
+    | eof { [] }
+    | "" { address_plus lexbuf }
+
+and address_plus = parse
+    | name as name {
+        check_colon lexbuf;
+        let parameters = parameters lexbuf in
+        if semi_colon lexbuf then
+          (name, parameters) :: address_plus lexbuf
+        else begin
+          check_eof lexbuf;
+          [(name, parameters)]
+        end
+      }
+    | ":" {
+        fail lexbuf "empty transport name"
+      }
+    | eof {
+        fail lexbuf "address expected"
+      }
+
+and semi_colon = parse
+    | ";" { true }
+    | "" { false }
+
+and check_eof = parse
+    | eof { () }
+    | _ as ch { fail lexbuf "invalid character %C" ch }
+
+and check_colon = parse
+    | ":" { () }
+    | "" { fail lexbuf "colon expected after transport name" }
+
+and parameters = parse
+    | name as key {
+        check_equal lexbuf;
+        let value = value (Buffer.create 42) lexbuf in
+        if coma lexbuf then
+          (key, value) :: parameters_plus lexbuf
+        else
+          [(key, value)]
+      }
+    | "=" { fail lexbuf "empty key" }
+    | "" { [] }
+
+and parameters_plus = parse
+    | name as key {
+        check_equal lexbuf;
+        let value = value (Buffer.create 42) lexbuf in
+        if coma lexbuf then
+          (key, value) :: parameters_plus lexbuf
+        else
+          [(key, value)]
+      }
+    | "=" { fail lexbuf "empty key" }
+    | "" { fail lexbuf "parameter expected" }
+
+and coma = parse
+    | "," { true }
+    | "" { false }
+
+and check_equal = parse
+    | "=" { () }
+    | "" { fail lexbuf "equal expected after key" }
+
+and value buf = parse
+    | [ '0'-'9' 'A'-'Z' 'a'-'z' '_' '-' '/' '.' '\\' ] as ch {
+        Buffer.add_char buf ch;
+        value buf lexbuf
+      }
+    | "%" {
+        Buffer.add_string buf (unescape lexbuf);
+        value buf lexbuf
+      }
+    | "" {
+        Buffer.contents buf
+      }
+
+and unescape = parse
+    | [ '0'-'9' 'a'-'f' 'A'-'F' ] [ '0'-'9' 'a'-'f' 'A'-'F' ] as str
+        { OBus_util.hex_decode str }
+    | ""
+        { failwith "two hexdigits expected after '%'" }
diff --git a/src/protocol/oBus_auth.ml b/src/protocol/oBus_auth.ml
new file mode 100644
index 0000000..1bce780
--- /dev/null
+++ b/src/protocol/oBus_auth.ml
@@ -0,0 +1,856 @@
+(*
+ * oBus_auth.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(auth)"
+
+open Printf
+open Lwt.Infix
+
+type capability = [ `Unix_fd ]
+
+let capabilities = [`Unix_fd]
+
+(* Maximum line length, if line greated are received, authentication
+   will fail *)
+let max_line_length = 42 * 1024
+
+(* Maximum number of reject, if a client is rejected more than that,
+   authentication will fail *)
+let max_reject = 42
+
+exception Auth_failure of string
+let auth_failure fmt = ksprintf (fun msg -> Lwt.fail (Auth_failure msg)) fmt
+
+let () =
+  Printexc.register_printer
+    (function
+       | Auth_failure msg ->
+           Some(Printf.sprintf "D-Bus authentication failed: %s" msg)
+       | _ ->
+           None)
+
+let hex_encode = OBus_util.hex_encode
+let hex_decode str =
+  try
+    OBus_util.hex_decode str
+  with
+    | Invalid_argument _ -> failwith "invalid hex-encoded data"
+
+type data = string
+
+type client_command =
+  | Client_auth of (string * data option) option
+  | Client_cancel
+  | Client_begin
+  | Client_data of data
+  | Client_error of string
+  | Client_negotiate_unix_fd
+
+type server_command =
+  | Server_rejected of string list
+  | Server_ok of OBus_address.guid
+  | Server_data of data
+  | Server_error of string
+  | Server_agree_unix_fd
+
+(* +-----------------------------------------------------------------+
+   | Keyring for the SHA-1 method                                    |
+   +-----------------------------------------------------------------+ *)
+
+module Cookie =
+struct
+  type t = {
+    id : int32;
+    time : int64;
+    cookie : string;
+  }
+
+  let id c = c.id
+  let time c = c.time
+  let cookie c = c.cookie
+end
+
+module Keyring : sig
+
+  type context = string
+      (** A context for the SHA-1 method *)
+
+  val load : context -> Cookie.t list Lwt.t
+    (** [load context] load all cookies for context [context] *)
+
+  val save : context -> Cookie.t list -> unit Lwt.t
+    (** [save context cookies] save all cookies with context
+        [context] *)
+end = struct
+
+  type context = string
+
+  let keyring_directory = lazy(
+    let%lwt homedir = Lazy.force OBus_util.homedir in
+    Lwt.return (Filename.concat homedir ".dbus-keyrings")
+  )
+
+  let keyring_file_name context =
+    let%lwt dir = Lazy.force keyring_directory in
+    Lwt.return (Filename.concat dir context)
+
+  let parse_line line =
+    Scanf.sscanf line "%ld %Ld %[a-fA-F0-9]"
+      (fun id time cookie -> { Cookie.id = id;
+                               Cookie.time = time;
+                               Cookie.cookie = cookie })
+
+  let print_line cookie =
+    sprintf  "%ld %Ld %s" (Cookie.id cookie) (Cookie.time cookie) (Cookie.cookie cookie)
+
+  let load context =
+    let%lwt fname = keyring_file_name context in
+    if Sys.file_exists fname then
+      try%lwt
+        Lwt_stream.get_while (fun _ -> true) (Lwt_stream.map parse_line (Lwt_io.lines_of_file fname))
+      with exn ->
+        let%lwt fname = keyring_file_name context in
+        let%lwt () = Lwt_log.error_f ~exn ~section "failed to load cookie file %s" fname in
+        Lwt.fail exn
+    else
+      Lwt.return []
+
+  let lock_file fname =
+    let really_lock () =
+      Lwt_unix.openfile fname
+        [Unix.O_WRONLY;
+         Unix.O_EXCL;
+         Unix.O_CREAT] 0o600
+      >>= Lwt_unix.close
+    in
+    let rec aux = function
+      | 0 ->
+          let%lwt () =
+            try%lwt
+              let%lwt () = Lwt_unix.unlink fname in
+              Lwt_log.info_f ~section "stale lock file %s removed" fname
+            with Unix.Unix_error(error, _, _) as exn ->
+              let%lwt () = Lwt_log.error_f ~section "failed to remove stale lock file %s: %s" fname (Unix.error_message error) in
+              Lwt.fail exn
+          in
+          (try%lwt
+             really_lock ()
+           with Unix.Unix_error(error, _, _) as exn ->
+             let%lwt () = Lwt_log.error_f ~section "failed to lock file %s after removing it: %s" fname (Unix.error_message error) in
+             Lwt.fail exn)
+      | n ->
+          try%lwt
+            really_lock ()
+          with exn ->
+            let%lwt () = Lwt_log.info_f ~section "waiting for lock file (%d) %s" n fname in
+            let%lwt () = Lwt_unix.sleep 0.250 in
+            aux (n - 1)
+    in
+    aux 32
+
+  let unlock_file fname =
+    try%lwt
+      Lwt_unix.unlink fname
+    with Unix.Unix_error(error, _, _) as exn ->
+      let%lwt () = Lwt_log.error_f ~section "failed to unlink file %s: %s" fname (Unix.error_message error) in
+      Lwt.fail exn
+
+  let save context cookies =
+    let%lwt fname = keyring_file_name context in
+    let tmp_fname = fname ^ "." ^ hex_encode (OBus_util.random_string 8) in
+    let lock_fname = fname ^ ".lock" in
+    let%lwt dir = Lazy.force keyring_directory in
+    let%lwt () =
+      (* Check that the keyring directory exists, or create it *)
+      if not (Sys.file_exists dir) then begin
+        try%lwt
+          Lwt_unix.mkdir dir 0o700
+        with Unix.Unix_error(error, _, _) as exn ->
+          let%lwt () = Lwt_log.error_f ~section "failed to create directory %s with permissions 0600: %s" dir (Unix.error_message error) in
+          Lwt.fail exn
+      end else
+        Lwt.return ()
+    in
+    let%lwt () = lock_file lock_fname in begin
+      let%lwt () =
+        try%lwt
+          Lwt_io.lines_to_file tmp_fname (Lwt_stream.map print_line (Lwt_stream.of_list cookies))
+        with exn ->
+          let%lwt () = Lwt_log.error_f ~exn ~section "unable to write temporary keyring file %s" tmp_fname in
+          Lwt.fail exn
+      in
+      try
+        Lwt_unix.rename tmp_fname fname
+      with Unix.Unix_error(error, _, _) as exn ->
+        let%lwt () = Lwt_log.error_f ~section "unable to rename file %s to %s: %s" tmp_fname fname (Unix.error_message error) in
+        Lwt.fail exn
+    end
+    [%lwt.finally 
+      unlock_file lock_fname]
+end
+
+(* +-----------------------------------------------------------------+
+   | Communication                                                   |
+   +-----------------------------------------------------------------+ *)
+
+type stream = {
+  recv : unit -> string Lwt.t;
+  send : string -> unit Lwt.t;
+}
+
+let make_stream ~recv ~send = {
+  recv = (fun () ->
+            try%lwt
+              recv ()
+            with
+              | Auth_failure _ as exn ->
+                  Lwt.fail exn
+              | End_of_file ->
+                  Lwt.fail (Auth_failure("input: premature end of input"))
+              | exn ->
+                  Lwt.fail (Auth_failure("input: " ^ Printexc.to_string exn)));
+  send = (fun line ->
+            try%lwt
+              send line
+            with
+              | Auth_failure _ as exn ->
+                  Lwt.fail exn
+              | exn ->
+                  Lwt.fail (Auth_failure("output: " ^ Printexc.to_string exn)));
+}
+
+let stream_of_channels (ic, oc) =
+  make_stream
+    ~recv:(fun () ->
+             let buf = Buffer.create 42 in
+             let rec loop last =
+               if Buffer.length buf > max_line_length then
+                 Lwt.fail (Auth_failure "input: line too long")
+               else
+                 Lwt_io.read_char_opt ic >>= function
+                   | None ->
+                       Lwt.fail (Auth_failure "input: premature end of input")
+                   | Some ch ->
+                       Buffer.add_char buf ch;
+                       if last = '\r' && ch = '\n' then
+                         Lwt.return (Buffer.contents buf)
+                       else
+                         loop ch
+             in
+             loop '\x00')
+    ~send:(fun line ->
+             let%lwt () = Lwt_io.write oc line in
+             Lwt_io.flush oc)
+
+let stream_of_fd fd =
+  make_stream
+    ~recv:(fun () ->
+             let buf = Buffer.create 42 and tmp = Bytes.create 1 in
+             let rec loop last =
+               if Buffer.length buf > max_line_length then
+                 Lwt.fail (Auth_failure "input: line too long")
+               else
+                 Lwt_unix.read fd tmp 0 1 >>= function
+                   | 0 ->
+                       Lwt.fail (Auth_failure "input: premature end of input")
+                   | 1 ->
+                       let ch = Bytes.get tmp 0 in
+                       Buffer.add_char buf ch;
+                       if last = '\r' && ch = '\n' then
+                         Lwt.return (Buffer.contents buf)
+                       else
+                         loop ch
+                   | n ->
+                       assert false
+             in
+             loop '\x00')
+    ~send:(fun line ->
+             let rec loop ofs len =
+               if len = 0 then
+                 Lwt.return ()
+               else
+                 Lwt_unix.write_string fd line ofs len >>= function
+                   | 0 ->
+                       Lwt.fail (Auth_failure "output: zero byte written")
+                   | n ->
+                       assert (n > 0 && n <= len);
+                       loop (ofs + n) (len - n)
+             in
+             loop 0 (String.length line))
+
+let send_line mode stream line =
+  ignore (Lwt_log.debug_f ~section "%s: sending: %S" mode line);
+  stream.send (line ^ "\r\n")
+
+let rec recv_line stream =
+  let%lwt line = stream.recv () in
+  let len = String.length line in
+  if len < 2 || not (line.[len - 2] = '\r' && line.[len - 1] = '\n') then
+    Lwt.fail (Auth_failure("input: invalid line received"))
+  else
+    Lwt.return (String.sub line 0 (len - 2))
+
+let rec first f str pos =
+  if pos = String.length str then
+    pos
+  else match f str.[pos] with
+    | true -> pos
+    | false -> first f str (pos + 1)
+
+let rec last f str pos =
+  if pos = 0 then
+    pos
+  else match f str.[pos - 1] with
+    | true -> pos
+    | false -> first f str (pos - 1)
+
+let blank ch = ch = ' ' || ch = '\t'
+let not_blank ch = not (blank ch)
+
+let sub_strip str i j =
+  let i = first not_blank str i in
+  let j = last not_blank str j in
+  if i < j then String.sub str i (j - i) else ""
+
+let split str =
+  let rec aux i =
+    let i = first not_blank str i in
+    if i = String.length str then
+      []
+    else
+      let j = first blank str i in
+      String.sub str i (j - i) :: aux j
+  in
+  aux 0
+
+let preprocess_line line =
+  (* Check for ascii-only *)
+  String.iter (function
+                 | '\x01'..'\x7f' -> ()
+                 | _ -> failwith "non-ascii characters in command") line;
+  (* Extract the command *)
+  let i = first blank line 0 in
+  if i = 0 then failwith "empty command";
+  (String.sub line 0 i, sub_strip line i (String.length line))
+
+let rec recv mode command_parser stream =
+  let%lwt line = recv_line stream in
+  let%lwt () = Lwt_log.debug_f ~section "%s: received: %S" mode line in
+
+  (* If a parse failure occur, return an error and try again *)
+  match
+    try
+      let command, args = preprocess_line line in
+      `Success(command_parser command args)
+    with exn ->
+      `Failure(exn)
+  with
+    | `Success x -> Lwt.return x
+    | `Failure(Failure msg) ->
+        let%lwt () = send_line mode stream ("ERROR \"" ^ msg ^ "\"") in
+        recv mode command_parser stream
+    | `Failure exn -> Lwt.fail exn
+
+let client_recv = recv "client"
+  (fun command args -> match command with
+     | "REJECTED" -> Server_rejected (split args)
+     | "OK" -> Server_ok(try OBus_uuid.of_string args with _ -> failwith "invalid hex-encoded guid")
+     | "DATA" -> Server_data(hex_decode args)
+     | "ERROR" -> Server_error args
+     | "AGREE_UNIX_FD" -> Server_agree_unix_fd
+     | _ -> failwith "invalid command")
+
+let server_recv = recv "server"
+  (fun command args -> match command with
+     | "AUTH" -> Client_auth(match split args with
+                               | [] -> None
+                               | [mech] -> Some(mech, None)
+                               | [mech; data] -> Some(mech, Some(hex_decode data))
+                               | _ -> failwith "too many arguments")
+     | "CANCEL" -> Client_cancel
+     | "BEGIN" -> Client_begin
+     | "DATA" -> Client_data(hex_decode args)
+     | "ERROR" -> Client_error args
+     | "NEGOTIATE_UNIX_FD" -> Client_negotiate_unix_fd
+     | _ -> failwith "invalid command")
+
+let client_send chans cmd = send_line "client" chans
+  (match cmd with
+     | Client_auth None -> "AUTH"
+     | Client_auth(Some(mechanism, None)) -> sprintf "AUTH %s" mechanism
+     | Client_auth(Some(mechanism, Some data)) -> sprintf "AUTH %s %s" mechanism (hex_encode data)
+     | Client_cancel -> "CANCEL"
+     | Client_begin -> "BEGIN"
+     | Client_data data -> sprintf "DATA %s" (hex_encode data)
+     | Client_error msg -> sprintf "ERROR \"%s\"" msg
+     | Client_negotiate_unix_fd -> "NEGOTIATE_UNIX_FD")
+
+let server_send chans cmd = send_line "server" chans
+  (match cmd with
+     | Server_rejected mechs -> String.concat " " ("REJECTED" :: mechs)
+     | Server_ok guid -> sprintf "OK %s" (OBus_uuid.to_string guid)
+     | Server_data data -> sprintf "DATA %s" (hex_encode data)
+     | Server_error msg -> sprintf "ERROR \"%s\"" msg
+     | Server_agree_unix_fd -> "AGREE_UNIX_FD")
+
+(* +-----------------------------------------------------------------+
+   | Client side authentication                                      |
+   +-----------------------------------------------------------------+ *)
+
+module Client =
+struct
+
+  type mechanism_return =
+    | Mech_continue of data
+    | Mech_ok of data
+    | Mech_error of string
+
+  class virtual mechanism_handler = object
+    method virtual init : mechanism_return Lwt.t
+    method data (chall : data) = Lwt.return (Mech_error("no data expected for this mechanism"))
+    method abort = ()
+  end
+
+  type mechanism = {
+    mech_name : string;
+    mech_exec : unit -> mechanism_handler;
+  }
+
+  let mech_name m = m.mech_name
+  let mech_exec m = m.mech_exec
+
+  (* +---------------------------------------------------------------+
+     | Predefined client mechanisms                                  |
+     +---------------------------------------------------------------+ *)
+
+  class mech_external_handler = object
+    inherit mechanism_handler
+    method init = Lwt.return (Mech_ok(string_of_int (Unix.getuid ())))
+  end
+
+  class mech_anonymous_handler = object
+    inherit mechanism_handler
+    method init = Lwt.return (Mech_ok("obus " ^ OBus_info.version))
+  end
+
+  class mech_dbus_cookie_sha1_handler = object
+    method init = Lwt.return (Mech_continue(string_of_int (Unix.getuid ())))
+    method data chal =
+      let%lwt () = Lwt_log.debug_f ~section "client: dbus_cookie_sha1: chal: %s" chal in
+      let context, id, chal = Scanf.sscanf chal "%[^/\\ \n\r.] %ld %[a-fA-F0-9]%!" (fun context id chal -> (context, id, chal)) in
+      let%lwt keyring = Keyring.load context in
+      let cookie =
+        try
+          List.find (fun cookie -> cookie.Cookie.id = id) keyring
+        with Not_found ->
+          ksprintf failwith "cookie %ld not found in context %S" id context
+      in
+      let rand = hex_encode (OBus_util.random_string 16) in
+      let resp = sprintf "%s %s" rand (hex_encode (OBus_util.sha_1 (sprintf "%s:%s:%s" chal rand cookie.Cookie.cookie))) in
+      let%lwt () = Lwt_log.debug_f ~section "client: dbus_cookie_sha1: resp: %s" resp in
+      Lwt.return (Mech_ok resp)
+    method abort = ()
+  end
+
+  let mech_external = {
+    mech_name = "EXTERNAL";
+    mech_exec = (fun () -> new mech_external_handler);
+  }
+  let mech_anonymous = {
+    mech_name = "ANONYMOUS";
+    mech_exec = (fun () -> new mech_anonymous_handler);
+  }
+  let mech_dbus_cookie_sha1 = {
+    mech_name = "DBUS_COOKIE_SHA1";
+    mech_exec = (fun () -> new mech_dbus_cookie_sha1_handler);
+  }
+
+  let default_mechanisms = [mech_external;
+                            mech_dbus_cookie_sha1;
+                            mech_anonymous]
+
+  (* +---------------------------------------------------------------+
+     | Client-side protocol                                          |
+     +---------------------------------------------------------------+ *)
+
+  type state =
+    | Waiting_for_data of mechanism_handler
+    | Waiting_for_ok
+    | Waiting_for_reject
+
+  type transition =
+    | Transition of client_command * state * mechanism list
+    | Success of OBus_address.guid
+    | Failure
+
+  (* Try to find a mechanism that can be initialised *)
+  let find_working_mech implemented_mechanisms available_mechanisms =
+    let rec aux = function
+      | [] ->
+          Lwt.return Failure
+      | { mech_name = name; mech_exec =  f } :: mechs ->
+          match available_mechanisms with
+            | Some l when not (List.mem name l) ->
+                aux mechs
+            | _ ->
+                let mech = f () in
+                try%lwt
+                  mech#init >>= function
+                    | Mech_continue resp ->
+                        Lwt.return (Transition(Client_auth(Some (name, Some resp)),
+                                               Waiting_for_data mech,
+                                               mechs))
+                    | Mech_ok resp ->
+                        Lwt.return (Transition(Client_auth(Some (name, Some resp)),
+                                               Waiting_for_ok,
+                                               mechs))
+                    | Mech_error msg ->
+                        aux mechs
+                with exn ->
+                  aux mechs
+    in
+    aux implemented_mechanisms
+
+  let initial mechs = find_working_mech mechs None
+  let next mechs available = find_working_mech mechs (Some available)
+
+  let transition mechs state cmd = match state with
+    | Waiting_for_data mech -> begin match cmd with
+        | Server_data chal ->
+            begin
+              try%lwt
+                mech#data chal >>= function
+                  | Mech_continue resp ->
+                      Lwt.return (Transition(Client_data resp,
+                                             Waiting_for_data mech,
+                                             mechs))
+                  | Mech_ok resp ->
+                      Lwt.return (Transition(Client_data resp,
+                                             Waiting_for_ok,
+                                             mechs))
+                  | Mech_error msg ->
+                      Lwt.return (Transition(Client_error msg,
+                                             Waiting_for_data mech,
+                                             mechs))
+              with exn ->
+                Lwt.return (Transition(Client_error(Printexc.to_string exn),
+                                       Waiting_for_data mech,
+                                       mechs))
+            end
+        | Server_rejected am ->
+            mech#abort;
+            next mechs am
+        | Server_error _ ->
+            mech#abort;
+            Lwt.return (Transition(Client_cancel,
+                                   Waiting_for_reject,
+                                   mechs))
+        | Server_ok guid ->
+            mech#abort;
+            Lwt.return (Success guid)
+        | Server_agree_unix_fd ->
+            mech#abort;
+            Lwt.return (Transition(Client_error "command not expected here",
+                                   Waiting_for_data mech,
+                                   mechs))
+      end
+
+    | Waiting_for_ok -> begin match cmd with
+        | Server_ok guid ->
+            Lwt.return (Success guid)
+        | Server_rejected am ->
+            next mechs am
+        | Server_data _
+        | Server_error _ ->
+            Lwt.return (Transition(Client_cancel,
+                                   Waiting_for_reject,
+                                   mechs))
+        | Server_agree_unix_fd ->
+            Lwt.return (Transition(Client_error "command not expected here",
+                                   Waiting_for_ok,
+                                   mechs))
+      end
+
+    | Waiting_for_reject -> begin match cmd with
+        | Server_rejected am -> next mechs am
+        | _ -> Lwt.return Failure
+      end
+
+  let authenticate ?(capabilities=[]) ?(mechanisms=default_mechanisms) ~stream () =
+    let rec loop = function
+      | Transition(cmd, state, mechs) ->
+          let%lwt () = client_send stream cmd in
+          let%lwt cmd = client_recv stream in
+          transition mechs state cmd >>= loop
+      | Success guid ->
+          let%lwt caps =
+            if List.mem `Unix_fd capabilities then
+              let%lwt () = client_send stream Client_negotiate_unix_fd in
+              client_recv stream >>= function
+                | Server_agree_unix_fd ->
+                    Lwt.return [`Unix_fd]
+                | Server_error _ ->
+                    Lwt.return []
+                | _ ->
+                    (* This case is not covered by the
+                       specification *)
+                    Lwt.return []
+            else
+              Lwt.return []
+          in
+          let%lwt () = client_send stream Client_begin in
+          Lwt.return (guid, caps)
+      | Failure ->
+          auth_failure "authentication failure"
+    in
+    initial mechanisms >>= loop
+end
+
+(* +-----------------------------------------------------------------+
+   | Server-side authentication                                      |
+   +-----------------------------------------------------------------+ *)
+
+module Server =
+struct
+
+  type mechanism_return =
+    | Mech_continue of data
+    | Mech_ok of int option
+    | Mech_reject
+
+  class virtual mechanism_handler = object
+    method init = Lwt.return (None : data option)
+    method virtual data : data -> mechanism_return Lwt.t
+    method abort = ()
+  end
+
+  type mechanism = {
+    mech_name : string;
+    mech_exec : int option -> mechanism_handler;
+  }
+
+  let mech_name m = m.mech_name
+  let mech_exec m = m.mech_exec
+
+  (* +---------------------------------------------------------------+
+     | Predefined server mechanisms                                  |
+     +---------------------------------------------------------------+ *)
+
+  class mech_external_handler user_id = object
+    inherit mechanism_handler
+    method data data =
+      match user_id, try Some(int_of_string data) with _ -> None with
+        | Some user_id, Some user_id' when user_id = user_id' ->
+            Lwt.return (Mech_ok(Some user_id))
+        | _ ->
+            Lwt.return Mech_reject
+  end
+
+  class mech_anonymous_handler = object
+    inherit mechanism_handler
+    method data _ = Lwt.return (Mech_ok None)
+  end
+
+  class mech_dbus_cookie_sha1_handler = object
+    inherit mechanism_handler
+
+    val context = "org_freedesktop_general"
+    val mutable state = `State1
+    val mutable user_id = None
+
+    method data resp =
+      try%lwt
+        let%lwt () = Lwt_log.debug_f ~section "server: dbus_cookie_sha1: resp: %s" resp in
+        match state with
+          | `State1 ->
+              user_id <- (try Some(int_of_string resp) with _ -> None);
+              let%lwt keyring = Keyring.load context in
+              let cur_time = Int64.of_float (Unix.time ()) in
+              (* Filter old and future keys *)
+              let keyring = List.filter (fun { Cookie.time = time } -> time <= cur_time && Int64.sub cur_time time <= 300L) keyring in
+              (* Find a working cookie *)
+              let%lwt id, cookie = match keyring with
+                | { Cookie.id = id; Cookie.cookie = cookie } :: _ ->
+                    (* There is still valid cookies, just choose one *)
+                    Lwt.return (id, cookie)
+                | [] ->
+                    (* No one left, generate a new one *)
+                    let id = Int32.abs (OBus_util.random_int32 ()) in
+                    let cookie = hex_encode (OBus_util.random_string 24) in
+                    let%lwt () = Keyring.save context [{ Cookie.id = id; Cookie.time = cur_time; Cookie.cookie = cookie }] in
+                    Lwt.return (id, cookie)
+              in
+              let rand = hex_encode (OBus_util.random_string 16) in
+              let chal = sprintf "%s %ld %s" context id rand in
+              let%lwt () = Lwt_log.debug_f ~section "server: dbus_cookie_sha1: chal: %s" chal in
+              state <- `State2(cookie, rand);
+              Lwt.return (Mech_continue chal)
+
+          | `State2(cookie, my_rand) ->
+              Scanf.sscanf resp "%s %s"
+                (fun its_rand comp_sha1 ->
+                   if OBus_util.sha_1 (sprintf "%s:%s:%s" my_rand its_rand cookie) = hex_decode comp_sha1 then
+                     Lwt.return (Mech_ok user_id)
+                   else
+                     Lwt.return Mech_reject)
+
+      with _ ->
+        Lwt.return Mech_reject
+
+    method abort = ()
+  end
+
+  let mech_anonymous = {
+    mech_name = "ANONYMOUS";
+    mech_exec = (fun uid -> new mech_anonymous_handler);
+  }
+  let mech_external = {
+    mech_name = "EXTERNAL";
+    mech_exec = (fun uid -> new mech_external_handler uid);
+  }
+  let mech_dbus_cookie_sha1 = {
+    mech_name = "DBUS_COOKIE_SHA1";
+    mech_exec = (fun uid -> new mech_dbus_cookie_sha1_handler);
+  }
+
+  let default_mechanisms = [mech_external;
+                            mech_dbus_cookie_sha1;
+                            mech_anonymous]
+
+  (* +---------------------------------------------------------------+
+     | Server-side protocol                                          |
+     +---------------------------------------------------------------+ *)
+
+  type state =
+    | Waiting_for_auth
+    | Waiting_for_data of mechanism_handler
+    | Waiting_for_begin of int option * capability list
+
+  type server_machine_transition =
+    | Transition of server_command * state
+    | Accept of int option * capability list
+    | Failure
+
+  let reject mechs =
+    Lwt.return (Transition(Server_rejected (List.map mech_name mechs),
+                           Waiting_for_auth))
+
+  let error msg =
+    Lwt.return (Transition(Server_error msg,
+                           Waiting_for_auth))
+
+  let transition user_id guid capabilities mechs state cmd = match state with
+    | Waiting_for_auth -> begin match cmd with
+        | Client_auth None ->
+            reject mechs
+        | Client_auth(Some(name, resp)) ->
+            begin match OBus_util.find_map (fun m -> if m.mech_name = name then Some m.mech_exec else None) mechs with
+              | None ->
+                  reject mechs
+              | Some f ->
+                  let mech = f user_id in
+                  try%lwt
+                    let%lwt init = mech#init in
+                    match init, resp with
+                      | None, None ->
+                          Lwt.return (Transition(Server_data "",
+                                                 Waiting_for_data mech))
+                      | Some chal, None ->
+                          Lwt.return (Transition(Server_data chal,
+                                                 Waiting_for_data mech))
+                      | Some chal, Some rest ->
+                          reject mechs
+                      | None, Some resp ->
+                          mech#data resp >>= function
+                            | Mech_continue chal ->
+                                Lwt.return (Transition(Server_data chal,
+                                                       Waiting_for_data mech))
+                            | Mech_ok uid ->
+                                Lwt.return (Transition(Server_ok guid,
+                                                       Waiting_for_begin(uid, [])))
+                            | Mech_reject ->
+                                reject mechs
+                  with exn ->
+                    reject mechs
+            end
+        | Client_begin -> Lwt.return Failure
+        | Client_error msg -> reject mechs
+        | _ -> error "AUTH command expected"
+      end
+
+    | Waiting_for_data mech -> begin match cmd with
+        | Client_data "" ->
+            Lwt.return (Transition(Server_data "",
+                                   Waiting_for_data mech))
+        | Client_data resp -> begin
+            try%lwt
+              mech#data resp >>= function
+                | Mech_continue chal ->
+                    Lwt.return (Transition(Server_data chal,
+                                           Waiting_for_data mech))
+                | Mech_ok uid ->
+                    Lwt.return (Transition(Server_ok guid,
+                                           Waiting_for_begin(uid, [])))
+                | Mech_reject ->
+                    reject mechs
+            with exn ->
+              reject mechs
+          end
+        | Client_begin -> mech#abort; Lwt.return Failure
+        | Client_cancel -> mech#abort; reject mechs
+        | Client_error _ -> mech#abort; reject mechs
+        | _ -> mech#abort; error "DATA command expected"
+      end
+
+    | Waiting_for_begin(uid, caps) -> begin match cmd with
+        | Client_begin ->
+            Lwt.return (Accept(uid, caps))
+        | Client_cancel ->
+            reject mechs
+        | Client_error _ ->
+            reject mechs
+        | Client_negotiate_unix_fd ->
+            if List.mem `Unix_fd capabilities then
+              Lwt.return(Transition(Server_agree_unix_fd,
+                                    Waiting_for_begin(uid,
+                                                      if List.mem `Unix_fd caps then
+                                                        caps
+                                                      else
+                                                        `Unix_fd :: caps)))
+            else
+              Lwt.return(Transition(Server_error "Unix fd passing is not supported by this server",
+                                    Waiting_for_begin(uid, caps)))
+        | _ ->
+            error "BEGIN command expected"
+      end
+
+  let authenticate ?(capabilities=[]) ?(mechanisms=default_mechanisms) ?user_id ~guid ~stream () =
+    let rec loop state count =
+      let%lwt cmd = server_recv stream in
+      transition user_id guid capabilities mechanisms state cmd >>= function
+        | Transition(cmd, state) ->
+            let count =
+              match cmd with
+                | Server_rejected _ -> count + 1
+                | _ -> count
+            in
+            (* Specification do not specify a limit for rejected, so
+               we choose one arbitrary *)
+            if count >= max_reject then
+              auth_failure "too many reject"
+            else
+              let%lwt () = server_send stream cmd in
+              loop state count
+        | Accept(uid, caps) ->
+            Lwt.return (uid, caps)
+        | Failure ->
+            auth_failure "authentication failure"
+    in
+    loop Waiting_for_auth 0
+end
diff --git a/src/protocol/oBus_auth.mli b/src/protocol/oBus_auth.mli
new file mode 100644
index 0000000..9aa297c
--- /dev/null
+++ b/src/protocol/oBus_auth.mli
@@ -0,0 +1,186 @@
+(*
+ * oBus_auth.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Handle authentication mechanisms *)
+
+type data = string
+    (** Data for an authentication mechanism *)
+
+exception Auth_failure of string
+  (** Exception raised when authentication fail *)
+
+(** List of capabilities clients/servers may support *)
+type capability =
+    [ `Unix_fd
+        (** The transport supports unix fd passing *) ]
+
+val capabilities : capability list
+  (** List of all capabilities *)
+
+(** {6 Communication} *)
+
+type stream
+  (** A stream is a way of communication for an authentication
+      procedure *)
+
+val make_stream : recv : (unit -> string Lwt.t) -> send : (string -> unit Lwt.t) -> stream
+  (** Creates a stream for authentication.
+
+      @param recv must read a complete line, ending with ["\r\n"],
+      @param send must send the given line. *)
+
+val stream_of_channels : Lwt_io.input_channel * Lwt_io.output_channel -> stream
+  (** Creates a stream from a pair of channels *)
+
+val stream_of_fd : Lwt_unix.file_descr -> stream
+  (** Creates a stream from a file descriptor. Note that the stream
+      created by this function is not really efficient because it has
+      to read characters one by one to ensure it does not consume too
+      much. *)
+
+val max_line_length : int
+  (** Maximum length accepted for lines of the authentication
+      protocol. Beyond this limit, authentication will fail. *)
+
+(** Client-side authentication *)
+module Client : sig
+
+  (** {6 Mechanisms} *)
+
+  type mechanism_return =
+      (** Value returned by the client side of an auth mechanism *)
+    | Mech_continue of data
+        (** Continue the authentication with this response *)
+    | Mech_ok of data
+        (** Authentification done *)
+    | Mech_error of string
+        (** Authentification failed *)
+
+  class virtual mechanism_handler : object
+    method virtual init : mechanism_return Lwt.t
+      (** Initial return value of the mechanism *)
+
+    method data : data -> mechanism_return Lwt.t
+      (** [mech_data] must continue the mechanism process with the given
+          data. Default implementation fail with an error message. *)
+
+    method abort : unit
+      (** Must abort the mechanism. *)
+  end
+
+  (** An client-side authentication mechanism *)
+  type mechanism = {
+    mech_name : string;
+    (** Name of the mechanism *)
+    mech_exec : unit -> mechanism_handler;
+    (** Mechanism creator *)
+  }
+
+  val mech_name : mechanism -> string
+    (** [mech_name] projection *)
+
+  val mech_exec : mechanism -> unit -> mechanism_handler
+    (** [mech_exec] projection *)
+
+  (** {8 Predefined mechanisms} *)
+
+  val mech_external : mechanism
+  val mech_anonymous : mechanism
+  val mech_dbus_cookie_sha1 : mechanism
+  val default_mechanisms : mechanism list
+
+  (** {6 Authentication} *)
+
+  val authenticate :
+    ?capabilities : capability list ->
+    ?mechanisms : mechanism list ->
+    stream : stream -> unit -> (OBus_address.guid * capability list) Lwt.t
+    (** Launch client-side authentication on the given stream. On
+        success it returns the unique identifier of the server address
+        and capabilities that were successfully negotiated with the
+        server.
+
+        Note: [authenticate] does not sends the initial null byte. You
+        have to handle it before calling [authenticate].
+
+        @param capabilities defaults to []
+        @param mechanisms defualts to {!default_mechanisms}
+    *)
+end
+
+(** Server-side authentication *)
+module Server : sig
+
+  (** {6 Mechanisms} *)
+
+  type mechanism_return =
+      (** Value returned by the server-side of an auth mechanism *)
+    | Mech_continue of data
+        (** Continue the authentication with this challenge *)
+    | Mech_ok of int option
+        (** The client is authenticated. The argument is the user id
+            the client is authenticated with. *)
+    | Mech_reject
+        (** The client is rejected by the mechanism *)
+
+  class virtual mechanism_handler : object
+    method init : data option Lwt.t
+      (** Initial challenge *)
+
+    method virtual data : data -> mechanism_return Lwt.t
+      (** [mech_data] must continue the mechanism process with the given
+          response. *)
+
+    method abort : unit
+      (** Must abort the mechanism *)
+  end
+
+  (** A server-side authentication mechanism *)
+  type mechanism = {
+    mech_name : string;
+    (** The mechanism name *)
+    mech_exec : int option -> mechanism_handler;
+    (** The mechanism creator. It receive the user id of the client,
+        if available. *)
+  }
+
+  val mech_name : mechanism -> string
+    (** [mech_name projection] *)
+  val mech_exec : mechanism -> int option -> mechanism_handler
+    (** [mech_exec projection] *)
+
+  (** {8 Predefined mechanisms} *)
+
+  val mech_anonymous : mechanism
+  val mech_external : mechanism
+  val mech_dbus_cookie_sha1 : mechanism
+  val default_mechanisms : mechanism list
+
+  (** {6 Authentication} *)
+
+  val authenticate :
+    ?capabilities : capability list ->
+    ?mechanisms : mechanism list ->
+    ?user_id : int ->
+    guid : OBus_address.guid ->
+    stream : stream -> unit -> (int option * capability list) Lwt.t
+    (** Launch server-side authentication on the given stream. On
+        success it returns the client uid and the list of capabilities
+        that were successfully negotiated. A client uid of {!None}
+        means that the client used anonymous authentication, and may
+        be disconnected according to server policy.
+
+        Note: [authenticate] does not read the first zero byte. You
+        must read it by hand, and maybe use it to receive credentials.
+
+        @param user_id is the user id determined by external method
+        @param capabilities defaults to [[]]
+        @param mechanisms default to {!default_mechanisms}
+    *)
+end
diff --git a/src/protocol/oBus_bus.ml b/src/protocol/oBus_bus.ml
new file mode 100644
index 0000000..e69297c
--- /dev/null
+++ b/src/protocol/oBus_bus.ml
@@ -0,0 +1,247 @@
+(*
+ * oBus_bus.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(bus)"
+
+open Lwt_react
+open Lwt.Infix
+open OBus_interfaces.Org_freedesktop_DBus
+
+type t = OBus_connection.t
+
+(* +-----------------------------------------------------------------+
+   | Local properties                                                |
+   +-----------------------------------------------------------------+ *)
+
+module String_set = Set.Make(String)
+
+type info = {
+  names : String_set.t signal;
+  set_names : String_set.t -> unit;
+  connection : OBus_connection.t;
+}
+
+let key = OBus_connection.new_key ()
+
+let name = OBus_connection.name
+
+let names connection =
+  match OBus_connection.get connection key with
+    | Some info -> info.names
+    | None -> invalid_arg "OBus_bus.names: not connected to a message bus"
+
+(* +-----------------------------------------------------------------+
+   | Message bus creation                                            |
+   +-----------------------------------------------------------------+ *)
+
+let proxy bus =
+  OBus_proxy.make (OBus_peer.make bus  OBus_protocol.bus_name) OBus_protocol.bus_path
+
+let exit_on_disconnect = function
+  | OBus_wire.Protocol_error msg ->
+      ignore (Lwt_log.error_f ~section "the D-Bus connection with the message bus has been closed due to a protocol error: %s" msg);
+      exit 1
+  | OBus_connection.Connection_lost ->
+      ignore (Lwt_log.info ~section "disconnected from D-Bus message bus");
+      exit 0
+  | OBus_connection.Transport_error exn ->
+      ignore (Lwt_log.error_f ~section "the D-Bus connection with the message bus has been closed due to a transport error: %s" (Printexc.to_string exn));
+      exit 1
+  | exn ->
+      ignore (Lwt_log.error ~section ~exn "the D-Bus connection with the message bus has been closed due to this uncaught exception");
+      exit 1
+
+(* Handle name lost/acquired events *)
+let update_names info message =
+  let open OBus_message in
+  let name = OBus_connection.name info.connection in
+  if name <> "" && message.destination = name then
+    match message with
+      | { sender = "org.freedesktop.DBus";
+          typ = Signal(["org"; "freedesktop"; "DBus"], "org.freedesktop.DBus", "NameAcquired");
+          body = [OBus_value.V.Basic(OBus_value.V.String name)] } ->
+          info.set_names (String_set.add name (S.value info.names));
+          Some message
+      | { sender = "org.freedesktop.DBus";
+          typ = Signal(["org"; "freedesktop"; "DBus"], "org.freedesktop.DBus", "NameLost");
+          body = [OBus_value.V.Basic(OBus_value.V.String name)] } ->
+          info.set_names (String_set.remove name (S.value info.names));
+          Some message
+      | _ ->
+          Some message
+  else
+    Some message
+
+let register_connection connection =
+  match OBus_connection.get connection key with
+    | None ->
+        let names, set_names = S.create String_set.empty in
+        let info = { names; set_names; connection } in
+        OBus_connection.set connection key (Some info);
+        let _ = Lwt_sequence.add_l (update_names info) (OBus_connection.incoming_filters connection) in
+        let%lwt name = OBus_method.call m_Hello (proxy connection) () in
+        OBus_connection.set_name connection name;
+        Lwt.return ()
+    | Some _ ->
+        Lwt.return ()
+
+let of_addresses ?switch addresses =
+  let%lwt bus = OBus_connection.of_addresses ?switch addresses ~shared:true in
+  let%lwt () = register_connection bus in
+  Lwt.return bus
+
+let session_bus = lazy(
+  try%lwt
+    let%lwt bus = Lazy.force OBus_address.session >>= of_addresses in
+    OBus_connection.set_on_disconnect bus exit_on_disconnect;
+    Lwt.return bus
+  with exn ->
+    let%lwt () = Lwt_log.warning ~exn ~section "Failed to open a connection to the session bus" in
+    Lwt.fail exn
+)
+
+let session ?switch () =
+  Lwt_switch.check switch;
+  let%lwt bus = Lazy.force session_bus in
+  let%lwt () = Lwt_switch.add_hook_or_exec switch (fun () -> OBus_connection.close bus) in
+  Lwt.return bus
+
+let system_bus_state = ref None
+let system_bus_mutex = Lwt_mutex.create ()
+
+let system ?switch () =
+  Lwt_switch.check switch;
+  let%lwt bus =
+    Lwt_mutex.with_lock system_bus_mutex
+      (fun () ->
+         match !system_bus_state with
+           | Some bus when S.value (OBus_connection.active bus) ->
+               Lwt.return bus
+           | _ ->
+               try%lwt
+                 let%lwt bus = Lazy.force OBus_address.system >>= of_addresses in
+                 system_bus_state := Some bus;
+                 Lwt.return bus
+               with exn ->
+                 let%lwt () = Lwt_log.warning ~exn ~section "Failed to open a connection to the system bus" in
+                 Lwt.fail exn)
+  in
+  let%lwt () = Lwt_switch.add_hook_or_exec switch (fun () -> OBus_connection.close bus) in
+  Lwt.return bus
+
+(* +-----------------------------------------------------------------+
+   | Bindings to functions of the message bus                        |
+   +-----------------------------------------------------------------+ *)
+
+exception Access_denied of string
+  [@@obus "org.freedesktop.DBus.Error.AccessDenied"]
+
+exception Service_unknown of string
+  [@@obus "org.freedesktop.DBus.Error.ServiceUnknown"]
+
+exception Match_rule_not_found of string
+  [@@obus "org.freedesktop.DBus.Error.MatchRuleNotFound"]
+
+exception Match_rule_invalid of string
+  [@@obus "org.freedesktop.DBus.Error.MatchRuleInvalid"]
+
+exception Name_has_no_owner of string
+  [@@obus "org.freedesktop.DBus.Error.NameHasNoOwner"]
+
+exception Adt_audit_data_unknown of string
+  [@@obus "org.freedesktop.DBus.Error.AdtAuditDataUnknown"]
+
+exception Selinux_security_context_unknown of string
+  [@@obus "org.freedesktop.DBus.Error.SELinuxSecurityContextUnknown"]
+
+let hello bus =
+  OBus_method.call m_Hello (proxy bus) ()
+
+type request_name_result = type_request_name_result
+
+let request_name bus ?(allow_replacement=false) ?(replace_existing=false) ?(do_not_queue=false) name =
+  let flags = [] in
+  let flags = if allow_replacement then `Allow_replacement :: flags else flags in
+  let flags = if replace_existing then `Replace_existing :: flags else flags in
+  let flags = if do_not_queue then `Do_not_queue :: flags else flags in
+  OBus_method.call m_RequestName (proxy bus) (name, cast_request_name_flags flags) >|= make_request_name_result
+
+type release_name_result = type_release_name_result
+
+let release_name bus name =
+  OBus_method.call m_ReleaseName (proxy bus) name >|= make_release_name_result
+
+type start_service_by_name_result = type_start_service_by_name_result
+
+let start_service_by_name bus name =
+  OBus_method.call m_StartServiceByName (proxy bus) (name, 0l) >|= make_start_service_by_name_result
+
+let name_has_owner bus name =
+  OBus_method.call m_NameHasOwner (proxy bus) name
+
+let list_names bus =
+  OBus_method.call m_ListNames (proxy bus) ()
+
+let list_activatable_names bus =
+  OBus_method.call m_ListActivatableNames (proxy bus) ()
+
+let get_name_owner bus name =
+  OBus_method.call m_GetNameOwner (proxy bus) name
+
+let list_queued_owners bus name =
+  OBus_method.call m_ListQueuedOwners (proxy bus) name
+
+let add_match bus rule =
+  OBus_method.call m_AddMatch (proxy bus) (OBus_match.string_of_rule rule)
+
+let remove_match bus rule =
+  OBus_method.call m_RemoveMatch (proxy bus) (OBus_match.string_of_rule rule)
+
+let update_activation_environment bus data =
+  OBus_method.call m_UpdateActivationEnvironment (proxy bus) data
+
+let get_connection_unix_user bus name =
+  OBus_method.call m_GetConnectionUnixUser (proxy bus) name >|= Int32.to_int
+
+let get_connection_unix_process_id bus name =
+  OBus_method.call m_GetConnectionUnixProcessID (proxy bus) name >|= Int32.to_int
+
+let get_adt_audit_session_data bus name =
+  OBus_method.call m_GetAdtAuditSessionData (proxy bus) name
+
+let get_connection_selinux_security_context bus name =
+  OBus_method.call m_GetConnectionSELinuxSecurityContext (proxy bus) name
+
+let reload_config bus =
+  OBus_method.call m_ReloadConfig (proxy bus) ()
+
+let get_id bus =
+  OBus_method.call m_GetId (proxy bus) () >|= OBus_uuid.of_string
+
+let name_owner_changed bus =
+  OBus_signal.make s_NameOwnerChanged (proxy bus)
+
+let name_lost bus =
+  OBus_signal.make s_NameLost (proxy bus)
+
+let name_acquired bus =
+  OBus_signal.make s_NameAcquired (proxy bus)
+
+let get_peer bus name =
+  try%lwt
+    let%lwt unique_name = get_name_owner bus name in
+    Lwt.return (OBus_peer.make bus unique_name)
+  with Name_has_no_owner msg ->
+    let%lwt _ = start_service_by_name bus name in
+    let%lwt unique_name = get_name_owner bus name in
+    Lwt.return (OBus_peer.make bus unique_name)
+
+let get_proxy bus name path =
+  let%lwt peer = get_peer bus name in
+  Lwt.return (OBus_proxy.make peer path)
diff --git a/src/protocol/oBus_bus.mli b/src/protocol/oBus_bus.mli
new file mode 100644
index 0000000..5586d01
--- /dev/null
+++ b/src/protocol/oBus_bus.mli
@@ -0,0 +1,202 @@
+(*
+ * oBus_bus.mli
+ * ------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Message buses management *)
+
+type t = OBus_connection.t
+
+(** {6 Well-known instances} *)
+
+val session : ?switch : Lwt_switch.t -> unit -> t Lwt.t
+  (** [session ?switch ()] returns a connection to the user session
+      message bus. Subsequent calls to {!session} will return the same
+      bus.  OBus will automatically exit the program when an error
+      happens on the session bus. You can change this behavior by
+      calling {!OBus_connection.set_on_disconnect}. *)
+
+val system : ?switch : Lwt_switch.t -> unit -> t Lwt.t
+  (** [system ?switch ()] returns a connection to the system message
+      bus. As for {!session}, subsequent calls to {!system} will
+      return the same bus. However, if the connection is closed or
+      crashes, {!system} will try to reopen it. *)
+
+(** {6 Creation} *)
+
+val of_addresses : ?switch : Lwt_switch.t -> OBus_address.t list -> t Lwt.t
+  (** Establish a connection with a message bus. The bus must be
+      accessible with at least one of the given addresses *)
+
+val register_connection : OBus_connection.t -> unit Lwt.t
+  (** Register the given connection to a message bus. It has the side
+      effect of requesting a name to the message bus if not already
+      done.
+
+      If the connection is a connection to a message bus, created with
+      one of the function of {!OBus_connection} then
+      {!register_connection} must be called on it before any other
+      functions. *)
+
+val exit_on_disconnect : exn -> 'a
+  (** Function which exit the program as follow:
+
+      - if [exn] is {!OBus_connection.Connection_lost}, it exits the
+      program with a return code of 0
+
+      - if [exn] is a fatal error, it prints a message on stderr and
+      exits the program with an exit code of 1
+  *)
+
+(** {6 Peer/proxy helpers} *)
+
+val get_peer : t -> OBus_name.bus -> OBus_peer.t Lwt.t
+  (** [get_peer bus name] returns the peer owning the bus name
+      [name]. If the service is not activated and is activable, then
+      it is started *)
+
+val get_proxy : t -> OBus_name.bus -> OBus_path.t -> OBus_proxy.t Lwt.t
+  (** [get_proxy bus name path] resolves [name] with {!get_peer} and
+      returns a proxy for the object with path [path] on this
+      service *)
+
+(** {6 Bus names} *)
+
+val name : t -> OBus_name.bus
+  (** Same as {!OBus_connection.name}. *)
+
+val names : t -> Set.Make(String).t React.signal
+  (** [names bus] is the signal holding the set of all names we
+      currently own. It raises [Invalid_argument] if the connection is
+      not a connection to a message bus. *)
+
+val hello : t -> OBus_name.bus Lwt.t
+  (** [hello connection] sends an hello message to the message bus,
+      which returns the unique connection name of the connection. Note
+      that if the hello message has already been sent, it will
+      fail. *)
+
+exception Access_denied of string
+  (** Exception raised when a name cannot be owned due to security
+      policies *)
+
+type request_name_result =
+    [ `Primary_owner
+        (** You are now the primary owner of the connection *)
+    | `In_queue
+        (** You will get the name when it will be available *)
+    | `Exists
+        (** Somebody else already have the name and nobody specified
+            what to do in this case *)
+    | `Already_owner
+        (** You already have the name *) ]
+
+val request_name : t ->
+  ?allow_replacement:bool ->
+  ?replace_existing:bool ->
+  ?do_not_queue:bool ->
+  OBus_name.bus -> request_name_result Lwt.t
+  (** Request a name to the bus. This is the way to acquire a
+      well-know name.
+
+      All optional parameters default to [false], their meaning are:
+
+      - [allow_replacement]: allow other application to steal this name from you
+      - [replace_existing]: replace any existing owner of the name
+      - [do_not_queue]: do not queue if not available
+  *)
+
+type release_name_result =
+    [ `Released
+    | `Non_existent
+    | `Not_owner ]
+
+val release_name : t -> OBus_name.bus -> release_name_result Lwt.t
+
+(** {6 Service starting/discovering} *)
+
+exception Service_unknown of string
+  (** Exception raised when a service is not present on a message bus
+      and can not be started automatically *)
+
+type start_service_by_name_result =
+    [ `Success
+    | `Already_running ]
+
+val start_service_by_name : t -> OBus_name.bus -> start_service_by_name_result Lwt.t
+  (** Start a service on the given bus by its name *)
+
+val name_has_owner : t -> OBus_name.bus -> bool Lwt.t
+  (** Returns [true] if the service is currently running, i.e. some
+      application offers it on the message bus *)
+
+val list_names : t -> OBus_name.bus list Lwt.t
+  (** List names currently running on the message bus *)
+
+val list_activatable_names : t -> OBus_name.bus list Lwt.t
+  (** List services that can be activated. A service is automatically
+      activated when you call one of its method or when you use
+      [start_service_by_name] *)
+
+exception Name_has_no_owner of string
+
+val get_name_owner : t -> OBus_name.bus -> OBus_name.bus Lwt.t
+  (** Return the connection unique name of the given service. Raise a
+      [Name_has_no_owner] if the given name does not have an owner. *)
+
+val list_queued_owners : t -> OBus_name.bus -> OBus_name.bus list Lwt.t
+  (** Return the connection unique names of the applications waiting for a
+      name *)
+
+(** {6 Messages routing} *)
+
+(** Note that you should prefer using {!OBus_match.export} and
+    {!OBus_match.remove} since they do not add duplicated rules
+    several times. *)
+
+exception Match_rule_invalid of string
+  (** Exception raised when the program tries to send an invalid match
+      rule. This should never happen since values of type
+      {!OBus_match.rule} are always valid. *)
+
+val add_match : t -> OBus_match.rule -> unit Lwt.t
+  (** Add a matching rule on a message bus. This means that every
+      message routed on the message bus matching this rule will be
+      sent to us.
+
+      It can raise {!OBus_error.No_memory}.
+  *)
+
+exception Match_rule_not_found of string
+
+val remove_match : t -> OBus_match.rule -> unit Lwt.t
+  (** Remove a match rule from the message bus. It raises
+      {!Match_rule_not_found} if the rule does not exists *)
+
+(** {6 Other} *)
+
+(** These functions are also offered by the message bus *)
+
+exception Adt_audit_data_unknown of string
+exception Selinux_security_context_unknown of string
+
+val update_activation_environment : t -> (string * string) list -> unit Lwt.t
+val get_connection_unix_user : t -> OBus_name.bus -> int Lwt.t
+val get_connection_unix_process_id : t -> OBus_name.bus -> int Lwt.t
+val get_adt_audit_session_data : t -> OBus_name.bus -> string Lwt.t
+val get_connection_selinux_security_context : t -> OBus_name.bus -> string Lwt.t
+val reload_config : t -> unit Lwt.t
+val get_id : t -> OBus_uuid.t Lwt.t
+
+(** {6 Signals} *)
+
+val name_owner_changed : t -> (OBus_name.bus * OBus_name.bus * OBus_name.bus) OBus_signal.t
+  (** This signal is emitted each time the owner of a name (unique
+      connection name or service name) changes. *)
+
+val name_lost : t -> OBus_name.bus OBus_signal.t
+val name_acquired : t -> OBus_name.bus OBus_signal.t
diff --git a/src/protocol/oBus_config.ml b/src/protocol/oBus_config.ml
new file mode 100644
index 0000000..d4ff3b8
--- /dev/null
+++ b/src/protocol/oBus_config.ml
@@ -0,0 +1,14 @@
+(* -*- tuareg -*-
+ * OBus_config.ml
+ * --------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Localtion of the machine id file: *)
+let machine_uuid_file = "/var/lib/dbus/machine-id"
+
+(* Version of obus: *)
+let version = "1.2.0"
diff --git a/src/protocol/oBus_connection.ml b/src/protocol/oBus_connection.ml
new file mode 100644
index 0000000..5256c8d
--- /dev/null
+++ b/src/protocol/oBus_connection.ml
@@ -0,0 +1,667 @@
+(*
+ * oBus_connection.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(connection)"
+
+open Lwt_react
+open Lwt.Infix
+
+(* +-----------------------------------------------------------------+
+   | Exceptions                                                      |
+   +-----------------------------------------------------------------+ *)
+
+exception Connection_closed
+exception Connection_lost
+exception Transport_error of exn
+
+let () =
+  Printexc.register_printer
+    (function
+       | Connection_closed ->
+           Some "D-Bus connection closed"
+       | Connection_lost ->
+           Some "D-Bus connection lost"
+       | Transport_error exn ->
+           Some(Printf.sprintf "D-Bus transport failure: %s" (Printexc.to_string exn))
+       | _ ->
+           None)
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+module Serial_map = Map.Make
+  (struct
+     type t = OBus_message.serial
+     let compare : int32 -> int32 -> int = compare
+   end)
+
+module Int_map = Map.Make
+  (struct
+     type t = int
+     let compare : int -> int -> int = compare
+   end)
+
+type filter = OBus_message.t -> OBus_message.t option
+  (* Type of message filters *)
+
+(* Connection are wrapped into object in order to make them
+   comparable. In the code, wrapped connection are simply referred has
+   "connection" and internal connection details are referred as
+   "active". *)
+
+(* Type of active connections *)
+type active_connection = {
+  mutable name : OBus_name.bus;
+  (* The name of the connection in case the endpoint is a message bus,
+     or [""] if not. *)
+
+  transport : OBus_transport.t;
+  (* The transport used for messages *)
+
+  mutable on_disconnect : exn -> unit Lwt.t;
+  (* [on_disconnect] is called the connection is closed
+     prematurely. This happen on transport errors. *)
+
+  guid : OBus_address.guid option;
+  (* Guid of the connection. It may is [Some guid] if this is the
+     client-side part of a peer-to-peer connection and the connection
+     is shared. *)
+
+  down : (unit Lwt.t * unit Lwt.u) option signal;
+  set_down : (unit Lwt.t * unit Lwt.u) option -> unit;
+  (* Waiting thread used to make the connection to stop dispatching
+     messages. *)
+
+  state : [ `Up | `Down ] signal;
+
+  abort_recv_wakener : OBus_message.t Lwt.u;
+  abort_send_wakener : unit Lwt.u;
+  abort_recv_waiter : OBus_message.t Lwt.t;
+  abort_send_waiter : unit Lwt.t;
+  (* Waiting threads wakeup when the connection is closed or
+     aborted. It is used to make the dispatcher/writer to exit. *)
+
+  mutable next_serial : OBus_message.serial;
+  (* The first available serial, incremented for each message *)
+
+  mutable outgoing_mutex : Lwt_mutex.t;
+  (* Mutex used to serialise message sending *)
+
+  incoming_filters : filter Lwt_sequence.t;
+  outgoing_filters : filter Lwt_sequence.t;
+
+  mutable reply_waiters : OBus_message.t Lwt.u Serial_map.t;
+  (* Mapping serial -> thread waiting for a reply *)
+
+  mutable data : exn Int_map.t;
+  (* Set of locally stored values *)
+
+  wrapper : t;
+  (* The wrapper containing the connection *)
+}
+
+(* State of a connection *)
+and connection_state =
+  | Active of active_connection
+      (* The connection is currently active *)
+  | Closed
+      (* The connection has been closed gracefully *)
+  | Killed
+      (* The connection has been killed after an error happened *)
+
+(* Connections are packed into objects to make them comparable *)
+and t = <
+  state : connection_state;
+  (* Get the connection state *)
+
+  set_state : connection_state -> unit;
+  (* Sets the state of the connection *)
+
+  get : active_connection;
+  (* Returns the connection if it is active, and fail otherwise *)
+
+  active : bool signal;
+  (* Signal holding the current connection state. *)
+>
+
+let compare : t -> t -> int = Pervasives.compare
+
+(* +-----------------------------------------------------------------+
+   | Guids                                                           |
+   +-----------------------------------------------------------------+ *)
+
+(* Mapping from server guid to connection. *)
+module Guid_map = Map.Make(struct
+                            type t = OBus_address.guid
+                            let compare = Pervasives.compare
+                          end)
+
+let guid_connection_map = ref Guid_map.empty
+
+(* +-----------------------------------------------------------------+
+   | Filters                                                         |
+   +-----------------------------------------------------------------+ *)
+
+(* Apply a list of filter on a message, logging failure *)
+let apply_filters typ message filters =
+  try
+    Lwt_sequence.fold_l
+      (fun filter message -> match message with
+         | Some message -> filter message
+         | None -> None)
+      filters (Some message)
+  with exn ->
+    ignore (Lwt_log.error_f ~section ~exn "an %s filter failed with" typ);
+    None
+
+(* +-----------------------------------------------------------------+
+   | Connection closing                                              |
+   +-----------------------------------------------------------------+ *)
+
+let cleanup active ~is_crash =
+  begin
+    match active.guid with
+      | Some guid ->
+          guid_connection_map := Guid_map.remove guid !guid_connection_map
+      | None ->
+          ()
+  end;
+
+  (* This make the dispatcher to exit if it is waiting on
+     [get_message] *)
+  Lwt.wakeup_exn active.abort_recv_wakener Connection_closed;
+  begin
+    match S.value active.down with
+      | Some(waiter, wakener) ->
+          Lwt.wakeup_exn wakener Connection_closed
+      | None ->
+          ()
+  end;
+
+  (* Wakeup all reply handlers so they will not wait forever *)
+  Serial_map.iter (fun _ wakener -> Lwt.wakeup_exn wakener Connection_closed) active.reply_waiters;
+
+  (* If the connection is closed normally, flush it *)
+  let%lwt () =
+    if not is_crash then
+      Lwt_mutex.with_lock active.outgoing_mutex Lwt.return
+    else begin
+      Lwt.wakeup_exn active.abort_send_wakener Connection_closed;
+      Lwt.return ()
+    end
+  in
+
+  (* Shutdown the transport *)
+  try%lwt
+    OBus_transport.shutdown active.transport
+  with exn ->
+    Lwt_log.error ~section ~exn "failed to abort/shutdown the transport"
+
+let close connection =
+  match connection#state with
+    | Killed | Closed ->
+        Lwt.return ()
+    | Active active ->
+        connection#set_state Closed;
+        cleanup active ~is_crash:false
+
+let kill connection exn =
+  match connection#state with
+    | Killed | Closed ->
+        Lwt.return ()
+    | Active active ->
+        connection#set_state Killed;
+        let%lwt () = cleanup active ~is_crash:true in
+        try%lwt
+          active.on_disconnect exn
+        with exn ->
+          Lwt_log.error ~section ~exn "the error handler failed with"
+
+(* +-----------------------------------------------------------------+
+   | Sending messages                                                 |
+   +-----------------------------------------------------------------+ *)
+
+(* Send a message, maybe adding a reply waiter and return
+   [return_thread] *)
+let send_message_backend connection gen_serial reply_waiter_opt message =
+  let active = connection#get in
+  Lwt_mutex.with_lock active.outgoing_mutex
+    (fun () ->
+       let send_it, closed = match connection#state with
+         | Active _ ->
+             (true, false)
+         | Closed ->
+             (* Flush the connection if closed gracefully *)
+             (true, true)
+         | Killed ->
+             (false, true)
+       in
+       if send_it then begin
+         let message = if gen_serial then { message with OBus_message.serial = active.next_serial } else message in
+         match apply_filters "outgoing" message active.outgoing_filters with
+           | None ->
+               let%lwt () = Lwt_log.debug ~section "outgoing message dropped by filters" in
+               Lwt.fail (Failure "message dropped by filters")
+
+           | Some message ->
+               if not closed then begin
+                 match reply_waiter_opt with
+                   | Some(waiter, wakener) ->
+                       active.reply_waiters <- Serial_map.add (OBus_message.serial message) wakener active.reply_waiters;
+                       Lwt.on_cancel waiter (fun () ->
+                                               match connection#state with
+                                                 | Killed | Closed ->
+                                                     ()
+                                                 | Active active ->
+                                                     active.reply_waiters <- Serial_map.remove (OBus_message.serial message) active.reply_waiters)
+                   | None ->
+                       ()
+               end;
+
+               try%lwt
+                 let%lwt () = Lwt.choose [active.abort_send_waiter;
+                                          (* Do not cancel a thread while it is marshaling message: *)
+                                          Lwt.protected (OBus_transport.send active.transport message)] in
+                 (* Everything went OK, continue with a new serial *)
+                 if gen_serial then active.next_serial <- Int32.succ active.next_serial;
+                 Lwt.return ()
+               with
+                 | OBus_wire.Data_error _ as exn ->
+                     (* The message can not be marshaled for some
+                        reason. This is not a fatal error. *)
+                     Lwt.fail exn
+
+                 | Lwt.Canceled ->
+                     (* Message sending have been canceled by the
+                        user. This is not a fatal error either. *)
+                     Lwt.fail Lwt.Canceled
+
+                 | exn ->
+                     (* All other errors are considered as fatal. They
+                        are fatal because it is possible that a
+                        message has been partially sent on the
+                        connection, so the message stream is broken *)
+                     let%lwt () = kill connection exn in
+                     Lwt.fail exn
+       end else
+         match connection#state with
+           | Killed | Closed ->
+               Lwt.fail Connection_closed
+           | Active _ ->
+               Lwt.return ())
+
+let send_message connection message =
+  send_message_backend connection true None message
+
+let send_message_with_reply connection message =
+  let (waiter, wakener) as v = Lwt.task () in
+  let%lwt () = send_message_backend connection true (Some v) message in
+  waiter
+
+let send_message_keep_serial connection message =
+  send_message_backend connection false None message
+
+let send_message_keep_serial_with_reply connection message =
+  let (waiter, wakener) as v = Lwt.task () in
+  let%lwt () = send_message_backend connection false (Some v) message in
+  waiter
+
+(* +-----------------------------------------------------------------+
+   | Helpers for calling methods                                     |
+   +-----------------------------------------------------------------+ *)
+
+let method_call_with_message ~connection ?destination ~path ?interface ~member ~i_args ~o_args args =
+  let i_msg =
+    OBus_message.method_call
+      ?destination
+      ~path
+      ?interface
+      ~member
+      (OBus_value.C.make_sequence i_args args)
+  in
+  let%lwt o_msg = send_message_with_reply connection i_msg in
+  match o_msg with
+    | { OBus_message.typ = OBus_message.Method_return _; body } -> begin
+        try
+          Lwt.return (o_msg, OBus_value.C.cast_sequence o_args body)
+        with OBus_value.C.Signature_mismatch ->
+          Lwt.fail (OBus_message.invalid_reply i_msg (OBus_value.C.type_sequence o_args) o_msg)
+      end
+    | { OBus_message.typ = OBus_message.Error(_, error_name);
+        OBus_message.body = OBus_value.V.Basic(OBus_value.V.String message) :: _  } ->
+        Lwt.fail (OBus_error.make error_name message)
+    | { OBus_message.typ = OBus_message.Error(_, error_name) } ->
+        Lwt.fail (OBus_error.make error_name "")
+    | _ ->
+        assert false
+
+let method_call ~connection ?destination ~path ?interface ~member ~i_args ~o_args args =
+  method_call_with_message ~connection ?destination ~path ?interface ~member ~i_args ~o_args args >|= snd
+
+let method_call_no_reply ~connection ?destination ~path ?interface ~member ~i_args args =
+  send_message connection
+    (OBus_message.method_call
+       ~flags:{ OBus_message.default_flags with OBus_message.no_reply_expected = true }
+       ?destination
+       ~path
+       ?interface
+       ~member
+       (OBus_value.C.make_sequence i_args args))
+
+(* +-----------------------------------------------------------------+
+   | Reading/dispatching                                             |
+   +-----------------------------------------------------------------+ *)
+
+let dispatch_message active message =
+  let open OBus_message in
+  match message with
+
+    (* For method return and errors, we lookup at the reply waiters. If
+       one is find then it get the reply, if none, then the reply is
+       dropped. *)
+    | { typ = Method_return(reply_serial) }
+    | { typ = Error(reply_serial, _) } -> begin
+        match try Some(Serial_map.find reply_serial active.reply_waiters) with Not_found -> None with
+          | Some w ->
+              active.reply_waiters <- Serial_map.remove reply_serial active.reply_waiters;
+              Lwt.wakeup w message;
+              Lwt.return ()
+          | None ->
+              Lwt_log.debug_f ~section "reply to message with serial %ld dropped%s"
+                reply_serial
+                (match message with
+                   | { typ = Error(_, error_name) } ->
+                       Printf.sprintf ", the reply is the error: %S: %S"
+                         error_name
+                         (match message.body with
+                            | OBus_value.V.Basic(OBus_value.V.String x) :: _ -> x
+                            | _ -> "")
+                   | _ ->
+                       "")
+      end
+
+    (* Handling of the special "org.freedesktop.DBus.Peer" interface *)
+    | { typ = Method_call(_, "org.freedesktop.DBus.Peer", member); body; sender; serial } -> begin
+        try%lwt
+          let%lwt body =
+            match member, body with
+              | "Ping", [] ->
+                  Lwt.return []
+              | "GetMachineId", [] -> begin
+                  try%lwt
+                    let%lwt uuid = Lazy.force OBus_info.machine_uuid in
+                    Lwt.return [OBus_value.V.basic_string (OBus_uuid.to_string uuid)]
+                  with exn ->
+                    if OBus_error.name exn = OBus_error.ocaml then
+                      Lwt.fail
+                        (OBus_error.Failed
+                           (Printf.sprintf
+                              "Cannot read the machine uuid file (%s)"
+                              OBus_config.machine_uuid_file))
+                    else
+                      Lwt.fail exn
+                end
+              | _ ->
+                  Lwt.fail
+                    (OBus_error.Unknown_method
+                       (Printf.sprintf
+                          "Method %S with signature %S on interface \"org.freedesktop.DBus.Peer\" does not exist"
+                          member
+                          (OBus_value.string_of_signature (OBus_value.V.type_of_sequence body))))
+          in
+          send_message active.wrapper {
+            flags = { no_reply_expected = true; no_auto_start = true };
+            serial = 0l;
+            typ = Method_return serial;
+            destination = sender;
+            sender = "";
+            body = body;
+          }
+        with exn ->
+          let name, msg = OBus_error.cast exn in
+          send_message active.wrapper {
+            flags = { no_reply_expected = true; no_auto_start = true };
+            serial = 0l;
+            typ = Error(serial, name);
+            destination = sender;
+            sender = "";
+            body = [OBus_value.V.basic_string msg];
+          }
+      end
+
+    | _ ->
+        (* Other messages are handled by specifics modules *)
+        Lwt.return ()
+
+let rec dispatch_forever active =
+  let%lwt () =
+    (* Wait for the connection to become up *)
+    match S.value active.down with
+      | Some(waiter, wakener) ->
+          waiter
+      | None ->
+          Lwt.return ()
+  in
+  let%lwt message =
+    try%lwt
+      Lwt.choose [OBus_transport.recv active.transport; active.abort_recv_waiter]
+    with exn ->
+      let%lwt () = kill active.wrapper (Transport_error exn) in
+      Lwt.fail exn
+  in
+  match apply_filters "incoming" message active.incoming_filters with
+    | None ->
+        let%lwt () = Lwt_log.debug ~section "incoming message dropped by filters" in
+        dispatch_forever active
+    | Some message ->
+        (* The internal dispatcher accepts only messages destined to
+           the current connection: *)
+        if active.name = "" || OBus_message.destination message = active.name then ignore (
+          (try%lwt
+            dispatch_message active message
+          with exn ->
+            Lwt_log.error ~section ~exn "message dispatching failed with")
+          [%lwt.finally
+            OBus_value.V.sequence_close (OBus_message.body message)]
+        );
+        dispatch_forever active
+
+(* +-----------------------------------------------------------------+
+   | Connection creation                                             |
+   +-----------------------------------------------------------------+ *)
+
+class connection () =
+  let active, set_active = S.create false in
+object(self)
+
+  method active = active
+
+  val mutable state = Closed
+
+  method state = state
+
+  method set_state new_state =
+    state <- new_state;
+    match state with
+      | Closed | Killed ->
+          set_active false
+      | Active _ ->
+          set_active true
+
+  method get =
+    match state with
+      | Closed | Killed -> raise Connection_closed
+      | Active active -> active
+end
+
+let of_transport ?switch ?guid ?(up=true) transport =
+  Lwt_switch.check switch;
+  let make () =
+    let abort_recv_waiter, abort_recv_wakener = Lwt.wait ()
+    and abort_send_waiter, abort_send_wakener = Lwt.wait ()
+    and connection = new connection ()
+    and down, set_down = S.create (if up then None else Some(Lwt.wait ())) in
+    let state = S.map (function None -> `Up | Some _ -> `Down) down in
+    let active = {
+      name = "";
+      transport;
+      on_disconnect = (fun exn -> Lwt.return ());
+      guid;
+      down;
+      set_down;
+      state;
+      abort_recv_waiter;
+      abort_send_waiter;
+      abort_recv_wakener = abort_recv_wakener;
+      abort_send_wakener = abort_send_wakener;
+      outgoing_mutex = Lwt_mutex.create ();
+      next_serial = 1l;
+      incoming_filters = Lwt_sequence.create ();
+      outgoing_filters = Lwt_sequence.create ();
+      reply_waiters = Serial_map.empty;
+      data = Int_map.empty;
+      wrapper = connection;
+    } in
+    connection#set_state (Active active);
+    (* Start the dispatcher *)
+    ignore (dispatch_forever active);
+    Lwt_switch.add_hook switch (fun () -> close connection);
+    connection
+  in
+  match guid with
+    | None ->
+        make ()
+    | Some guid ->
+        match try Some(Guid_map.find guid !guid_connection_map) with Not_found -> None with
+          | Some connection ->
+              Lwt_switch.add_hook switch (fun () -> close connection);
+              connection
+          | None ->
+              let connection = make () in
+              guid_connection_map := Guid_map.add guid connection !guid_connection_map;
+              connection
+
+(* Capabilities turned on by default: *)
+let capabilities = [`Unix_fd]
+
+let of_addresses ?switch ?(shared=true) addresses =
+  Lwt_switch.check switch;
+  match shared with
+    | false ->
+        let%lwt guid, transport = OBus_transport.of_addresses ~capabilities addresses in
+        Lwt.return (of_transport ?switch transport)
+    | true ->
+        (* Try to find a guid that we already have *)
+        let guids = OBus_util.filter_map OBus_address.guid addresses in
+        match OBus_util.find_map (fun guid -> try Some(Guid_map.find guid !guid_connection_map) with Not_found -> None) guids with
+          | Some connection ->
+              Lwt_switch.add_hook switch (fun () -> close connection);
+              Lwt.return connection
+          | None ->
+              (* We ask again a shared connection even if we know that
+                 there is no other connection to a server with the same
+                 guid, because during the authentication another
+                 thread can add a new connection. *)
+              let%lwt guid, transport = OBus_transport.of_addresses ~capabilities addresses in
+              Lwt.return (of_transport ?switch ~guid transport)
+
+let loopback () = of_transport (OBus_transport.loopback ())
+
+(* +-----------------------------------------------------------------+
+   | Local storage                                                   |
+   +-----------------------------------------------------------------+ *)
+
+type 'a key = {
+  key_id : int;
+  key_make : 'a -> exn;
+  key_cast : exn -> 'a;
+}
+
+let next_key_id = ref 0
+
+let new_key (type t) () =
+  let key_id = !next_key_id in
+  next_key_id := key_id + 1;
+  let module M = struct exception E of t end in
+  {
+    key_id = key_id;
+    key_make = (fun x -> M.E x);
+    key_cast = (function M.E x -> x | _ -> assert false);
+  }
+
+let get connection key =
+  let active = connection#get in
+  try
+    let cell = Int_map.find key.key_id active.data in
+    Some(key.key_cast cell)
+  with Not_found ->
+    None
+
+let set connection key value =
+  let active = connection#get in
+  match value with
+    | Some x ->
+        active.data <- Int_map.add key.key_id (key.key_make x) active.data
+    | None ->
+        active.data <- Int_map.remove key.key_id active.data
+
+(* +-----------------------------------------------------------------+
+   | Other                                                           |
+   +-----------------------------------------------------------------+ *)
+
+let name connection = connection#get.name
+let set_name connection name = connection#get.name <- name
+
+let active connection = connection#active
+
+let guid connection = connection#get.guid
+let transport connection = connection#get.transport
+
+let can_send_basic_type connection = function
+  | OBus_value.T.Unix_fd -> List.mem `Unix_fd (OBus_transport.capabilities connection#get.transport)
+  | _ -> true
+
+let rec can_send_single_type connection = function
+  | OBus_value.T.Basic t -> can_send_basic_type connection t
+  | OBus_value.T.Array t -> can_send_single_type connection t
+  | OBus_value.T.Dict(tk, tv) -> can_send_basic_type connection tk && can_send_single_type connection tv
+  | OBus_value.T.Structure tl -> List.for_all (can_send_single_type connection) tl
+  | OBus_value.T.Variant -> true
+
+let can_send_sequence_type connection tl = List.for_all (can_send_single_type connection) tl
+
+let set_on_disconnect connection f =
+  match connection#state with
+    | Closed | Killed ->
+        ()
+    | Active active ->
+        active.on_disconnect <- f
+
+let state connection = connection#get.state
+
+let set_up connection =
+  let active = connection#get in
+  match S.value active.down with
+    | None ->
+        ()
+    | Some(waiter, wakener) ->
+        active.set_down None;
+        Lwt.wakeup wakener ()
+
+let set_down connection =
+  let active = connection#get in
+  match S.value active.down with
+    | Some _ ->
+        ()
+    | None ->
+        active.set_down (Some(Lwt.wait ()))
+
+let incoming_filters connection = connection#get.incoming_filters
+let outgoing_filters connection = connection#get.outgoing_filters
diff --git a/src/protocol/oBus_connection.mli b/src/protocol/oBus_connection.mli
new file mode 100644
index 0000000..ae34376
--- /dev/null
+++ b/src/protocol/oBus_connection.mli
@@ -0,0 +1,239 @@
+(*
+ * oBus_connection.mli
+ * -------------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus connections *)
+
+(** This module implements manipulation of a D-Bus connection. A D-Bus
+    connection is a channel opened with another application which also
+    implement the D-Bus protocol. It is used to exchange D-Bus
+    messages. *)
+
+type t
+    (** Type of D-Bus connections *)
+
+val compare : t -> t -> int
+  (** Same as [Pervasives.compare]. It allows this module to be used
+      as argument to the functors [Set.Make] and [Map.Make]. *)
+
+(** {6 Creation} *)
+
+(** The following functions will return a connection which is ready to
+    send and receive messages. You should use them only for direct
+    connection to another application without passing through a
+    message bus.
+
+    Otherwise you should use [OBus_bus] or immediately call
+    [OBus_bus.register_connection] after the creation. *)
+
+val of_addresses : ?switch : Lwt_switch.t -> ?shared : bool -> OBus_address.t list -> t Lwt.t
+  (** [of_addresses ?switch ?shared addresses] try to get a working
+      D-Bus connection from a list of addresses. The server must be
+      accessible from at least one of these addresses.
+
+      If [shared] is true and a connection to the same server is
+      already open, then it is used instead of [transport]. This is
+      the default behaviour. *)
+
+val loopback : unit -> t
+  (** Create a connection with a loopback transport *)
+
+val close : t -> unit Lwt.t
+  (** Close a connection.
+
+      All thread waiting for a reply will fail with the exception
+      {!Connection_closed}.
+
+      Notes:
+      - when a connection is closed, the transport it use is
+        closed too
+      - if the connection is already closed, it does nothing
+  *)
+
+val active : t -> bool React.signal
+  (** Returns whether a connection is active. *)
+
+exception Connection_closed
+  (** Raised when trying to use a closed connection *)
+
+exception Connection_lost
+  (** Raised when a connection has been lost *)
+
+exception Transport_error of exn
+  (** Raised when something wrong happens on the backend transport of
+      the connection *)
+
+(** {6 Informations} *)
+
+val name : t -> OBus_name.bus
+  (** Returns the unique name of the connection. This is only
+      meaningful is the other endpoint of the connection is a
+      message bus. If it is not the case it returns [""]. *)
+
+(**/**)
+val set_name : t -> OBus_name.bus -> unit
+(**/**)
+
+val transport : t -> OBus_transport.t
+  (** [transport connection] get the transport associated with a
+      connection *)
+
+val can_send_basic_type : t -> OBus_value.T.basic -> bool
+val can_send_single_type : t -> OBus_value.T.single -> bool
+val can_send_sequence_type : t -> OBus_value.T.sequence -> bool
+  (** [can_send_*_type connection typ] returns whether values of the
+      given type can be sent through the given connection. *)
+
+(** {6 Sending messages} *)
+
+(** These functions are the low-level functions for sending
+    messages. They take and return a complete message description *)
+
+val send_message : t -> OBus_message.t -> unit Lwt.t
+  (** [send_message connection message] send a message without
+      expecting a reply. *)
+
+val send_message_with_reply : t -> OBus_message.t -> OBus_message.t Lwt.t
+  (** [send_message_with_reply connection message] Send a message and
+      return a thread which waits for the reply (which is a method
+      return or an error) *)
+
+val send_message_keep_serial : t -> OBus_message.t -> unit Lwt.t
+  (** Same as {!send_message} but does not generate a serial for the
+      message.
+
+      Warning: this is for implementing a D-Bus daemon only, not for
+      casual use. *)
+
+val send_message_keep_serial_with_reply : t -> OBus_message.t -> OBus_message.t Lwt.t
+  (** Same as {!send_message_with_reply} but does not generate a serial
+      for the message.
+
+      Warning: this is for implementing a D-Bus daemon only, not for
+      casual use. *)
+
+(** {6 Helpers for calling methods} *)
+
+val method_call :
+  connection : t ->
+  ?destination : OBus_name.bus ->
+  path : OBus_path.t ->
+  ?interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence ->
+  o_args : 'b OBus_value.C.sequence ->
+  'a -> 'b Lwt.t
+  (** Calls a method using the given parameters, and waits for its
+      reply. *)
+
+val method_call_with_message :
+  connection : t ->
+  ?destination : OBus_name.bus ->
+  path : OBus_path.t ->
+  ?interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence ->
+  o_args : 'b OBus_value.C.sequence ->
+  'a -> (OBus_message.t * 'b) Lwt.t
+  (** Same as {!method_call}, but also returns the reply message so
+      you can extract informations from it. *)
+
+val method_call_no_reply :
+  connection : t ->
+  ?destination : OBus_name.bus ->
+  path : OBus_path.t ->
+  ?interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence ->
+  'a -> unit Lwt.t
+  (** Same as {!method_call} but does not expect a reply *)
+
+(** {6 General purpose filters} *)
+
+(** Filters are functions that are applied on all incoming and
+    outgoing messages.
+
+    For incoming messages they are called before dispatching, for
+    outgoing ones, they are called just before being sent.
+*)
+
+type filter = OBus_message.t -> OBus_message.t option
+  (** The result of a filter must be:
+
+      - [Some msg] where [msg] is the message given to the filter
+      modified or not, which means that the message is replaced by
+      this one
+
+      - [None] which means that the message will be dropped, i.e. not
+      dispatched or not sent *)
+
+val incoming_filters : t -> filter Lwt_sequence.t
+  (** Filters applied on incoming messages *)
+
+val outgoing_filters : t -> filter Lwt_sequence.t
+  (** Filters appllied on outgoing messages *)
+
+(** {6 Connection local Storage} *)
+
+(** Connection local storage allows to attach values to a
+    connection. It is internally used by modules of obus. *)
+
+type 'a key
+  (** Type of keys. Keys are used to identify a resource attached to a
+      connection. *)
+
+val new_key : unit -> 'a key
+  (** [new_key ()] generates a new key. *)
+
+val get : t -> 'a key -> 'a option
+  (** [get connection key] returns the data associated to [key] in
+      connection, if any. *)
+
+val set : t -> 'a key -> 'a option -> unit
+  (** [set connection key value] attach [value] to [connection] under
+      the key [key]. [set connection key None] will remove any
+      occurence of [key] from [connection]. *)
+
+(** {6 Errors handling} *)
+
+(** Note: when a filter/signal handler/method_call handler raise an
+    exception, it is just dropped. If {!OBus_info.debug} is set then a
+    message is printed on [stderr] *)
+
+val set_on_disconnect : t -> (exn -> unit Lwt.t) -> unit
+  (** Sets the function called when a fatal error happen or when the
+      conection is lost.
+
+      Notes:
+      - the default function does nothing
+      - it is not called when the connection is closed using {!close}
+      - if the connection is closed, it does nothing
+  *)
+
+(** {6 Low-level} *)
+
+val of_transport : ?switch : Lwt_switch.t -> ?guid : OBus_address.guid -> ?up : bool -> OBus_transport.t -> t
+  (** Create a D-Bus connection on the given transport. If [guid] is
+      provided the connection will be shared.
+
+      [up] tell whether the connection is initially up or down,
+      default is [true]. *)
+
+(** A connection can be up or down. Except for connections created with
+    [of_transport], newly created connections are always up.
+
+    When a connection is down, messages will not be dispatched *)
+
+val state : t -> [ `Up | `Down ] React.signal
+  (** Signal holding the current state of the connection *)
+
+val set_up : t -> unit
+  (** Sets up the connection if it is not already up *)
+
+val set_down : t -> unit
+  (** Sets down the connection if it is not already down *)
diff --git a/src/protocol/oBus_context.ml b/src/protocol/oBus_context.ml
new file mode 100644
index 0000000..f7f9de6
--- /dev/null
+++ b/src/protocol/oBus_context.ml
@@ -0,0 +1,37 @@
+(*
+ * oBus_context.ml
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+type t = {
+  connection : OBus_connection.t;
+  flags : OBus_message.flags;
+  sender : OBus_peer.t;
+  destination : OBus_peer.t;
+  serial : OBus_message.serial;
+}
+
+let key = Lwt.new_key ()
+
+let get () =
+  match Lwt.get key with
+    | Some ctx -> ctx
+    | None -> failwith "OBus_context.get: not in a method call handler"
+
+let make ~connection ~message = {
+  connection = connection;
+  flags = OBus_message.flags message;
+  sender = OBus_peer.make connection (OBus_message.sender message);
+  destination = OBus_peer.make connection (OBus_message.destination message);
+  serial = OBus_message.serial message;
+}
+
+let connection ctx = ctx.connection
+let flags ctx = ctx.flags
+let serial ctx = ctx.serial
+let sender ctx = ctx.sender
+let destination ctx = ctx.destination
diff --git a/src/protocol/oBus_context.mli b/src/protocol/oBus_context.mli
new file mode 100644
index 0000000..c5917d3
--- /dev/null
+++ b/src/protocol/oBus_context.mli
@@ -0,0 +1,51 @@
+(*
+ * oBus_context.mli
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Message contexts *)
+
+(** {6 Types} *)
+
+(** A context contains information about the reception of a
+    message. *)
+
+type t
+  (** Type of a context. *)
+
+(** {6 Creation} *)
+
+val make : connection : OBus_connection.t -> message : OBus_message.t -> t
+  (** Creates a context from the given connection and message *)
+
+(** {6 Retreival} *)
+
+val get : unit -> t
+  (** In a method call handler, this returns the context of the method
+      call. *)
+
+val key : t Lwt.key
+  (** The key used for storing the context. *)
+
+(** {6 Projections} *)
+
+val connection : t -> OBus_connection.t
+  (** Returns the connection part of a context *)
+
+val sender : t -> OBus_peer.t
+  (** [sender context] returns the peer who sends the message *)
+
+val destination : t -> OBus_peer.t
+  (** [destinatino context] returns the peer to which the message was
+      sent *)
+
+val flags : t -> OBus_message.flags
+  (** [flags context] returns the flags of the message that was
+      received *)
+
+val serial : t -> OBus_message.serial
+  (** Returns the serial of the message *)
diff --git a/src/protocol/oBus_error.ml b/src/protocol/oBus_error.ml
new file mode 100644
index 0000000..6a70ef0
--- /dev/null
+++ b/src/protocol/oBus_error.ml
@@ -0,0 +1,124 @@
+(*
+ * oBus_error.ml
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+type name = string
+type message = string
+
+type error = {
+  name : name;
+  make : message -> exn;
+  cast : exn -> message option;
+}
+
+exception DBus of name * message
+
+let ocaml = "org.ocamlcore.forge.obus.OCamlException"
+
+let () =
+  Printexc.register_printer
+    (function
+       | DBus(name, message) -> Some(Printf.sprintf "%s: %s" name message)
+       | _ -> None)
+
+(* List of all registered D-Bus errors *)
+let errors = ref []
+
+(* +-----------------------------------------------------------------+
+   | Creation/casting                                                |
+   +-----------------------------------------------------------------+ *)
+
+let make name message =
+  let rec loop = function
+    | [] ->
+        DBus(name, message)
+    | error :: errors ->
+        if error.name = name then
+          error.make message
+        else
+          loop errors
+  in
+  loop !errors
+
+let cast exn =
+  let rec loop = function
+    | [] ->
+        (ocaml, Printexc.to_string exn)
+    | error :: errors ->
+        match error.cast exn with
+          | Some message -> (error.name, message)
+          | None -> loop errors
+  in
+  match exn with
+    | DBus(name, message) -> (name, message)
+    | _ -> loop !errors
+
+let name exn =
+  let rec loop = function
+    | [] ->
+        ocaml
+    | error :: errors ->
+        match error.cast exn with
+          | Some message -> error.name
+          | None -> loop errors
+  in
+  match exn with
+    | DBus(name, message) -> name
+    | _ -> loop !errors
+
+(* +-----------------------------------------------------------------+
+   | Registration                                                    |
+   +-----------------------------------------------------------------+ *)
+
+module type Error = sig
+  exception E of string
+  val name : name
+end
+
+module Register(Error : Error) =
+struct
+  let () =
+    errors := {
+      name = Error.name;
+      make = (fun message -> Error.E message);
+      cast = (function
+                | Error.E message -> Some message
+                | _ -> None);
+    } :: !errors
+end
+
+(* +-----------------------------------------------------------------+
+   | Well-known exceptions                                           |
+   +-----------------------------------------------------------------+ *)
+
+exception Failed of message
+  [@@obus "org.freedesktop.DBus.Error.Failed"]
+
+exception Invalid_args of message
+  [@@obus "org.freedesktop.DBus.Error.InvalidArgs"]
+
+exception Unknown_method of message
+  [@@obus "org.freedesktop.DBus.Error.UnknownMethod"]
+
+exception Unknown_object of message
+  [@@obus "org.freedesktop.DBus.Error.UnknownObject"]
+
+exception Unknown_interface of message
+  [@@obus "org.freedesktop.DBus.Error.UnknownInterface"]
+
+exception Unknown_property of message
+  [@@obus "org.freedesktop.DBus.Error.UnknownProperty"]
+
+exception Property_read_only of message
+  [@@obus "org.freedesktop.DBus.Error.PropertyReadOnly"]
+
+exception No_memory of message
+  [@@obus "org.freedesktop.DBus.Error.NoMemory"]
+
+exception No_reply of message
+  [@@obus "org.freedesktop.DBus.Error.NoReply"]
diff --git a/src/protocol/oBus_error.mli b/src/protocol/oBus_error.mli
new file mode 100644
index 0000000..8af22bf
--- /dev/null
+++ b/src/protocol/oBus_error.mli
@@ -0,0 +1,120 @@
+(*
+ * oBus_error.mli
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus errors management *)
+
+(** This module integrates D-Bus errors into OCaml exceptions, and
+    OCaml exceptions into D-Bus errors.
+
+    To do this, an OCaml exception that maps a D-Bus error should be
+    registered with {!Register}. *)
+
+type name = OBus_name.error
+    (** An error name. For example: ["org.foo.bar.Error.Failed"] *)
+
+type message = string
+    (** An error message *)
+
+exception DBus of name * message
+  (** General exception for D-Bus errors. When the reply to a method
+      call is a D-Bus error that have not been registered, this
+      exception is raised.
+
+      Arguments are:
+      - the D-Bus error name
+      - the error message
+  *)
+
+val ocaml : name
+  (** The name of the D-Bus error which is generated for uncaught
+      ocaml exceptions that have not been registered *)
+
+(** {6 D-Bus errors creating/casting} *)
+
+val name : exn -> name
+  (** [name exn] returns the D-Bus error name under which this
+      exception is registered. If the exception is not registered,
+      then [ocaml] is returned. *)
+
+val make : name -> message -> exn
+  (** [make exn message] creates an exception from an error name and
+      an error message. If the name is not registered, then
+      [DBus(name, message)] is returned. *)
+
+val cast : exn -> name * message
+  (** [cast exn] returns the D-Bus name and message of the given
+      exception. If the exception is not registered, [(ocaml,
+      Printexc.to_string exn)] is returned. *)
+
+(** {6 Errors registration} *)
+
+(** Signature for D-Bus error *)
+module type Error = sig
+  exception E of string
+    (** The OCaml exception for this error *)
+
+  val name : name
+    (** The D-Bus name if this error *)
+end
+
+module Register(Error : Error) : sig end
+  (** Register an error. The typical use of the functor is:
+
+      {[
+        exception My_exception of string
+        let module M =
+          OBus_error.Register(struct
+                                exception E = My_exception
+                                let name = "my.exception.name"
+                              end)
+        in ()
+      ]}
+
+      But you can also write this with the syntax extension:
+
+      {[
+        exception My_exception of string
+          [@@obus "my.exception.name"]
+      ]}
+  *)
+
+(** {6 Well-known dbus exception} *)
+
+(** The following errors can be raised by any service. You can also
+    raise them in a method your service implement.
+
+    Note that the error message will normally be shown to the user so
+    they must be explicative. *)
+
+exception Failed of message
+  (** The [org.freedesktop.DBus.Error.Failed] error *)
+
+exception Invalid_args of message
+  (** The [org.freedesktop.DBus.Error.InvalidArgs] error *)
+
+exception Unknown_method of message
+  (** The [org.freedesktop.DBus.Error.UnknownMethod] error *)
+
+exception Unknown_object of message
+  (** The [org.freedesktop.DBus.Error.UnknownObject] error *)
+
+exception Unknown_interface of message
+  (** The [org.freedesktop.DBus.Error.UnknownInterface] error *)
+
+exception Unknown_property of message
+  (** The [org.freedesktop.DBus.Error.UnknownProperty] error *)
+
+exception Property_read_only of message
+  (** The [org.freedesktop.DBus.Error.PropertyReadOnly] error *)
+
+exception No_memory of message
+  (** The [org.freedesktop.DBus.Error.NoMemory] error *)
+
+exception No_reply of message
+  (** The [org.freedesktop.DBus.Error.NoReply] error *)
diff --git a/src/protocol/oBus_info.ml b/src/protocol/oBus_info.ml
new file mode 100644
index 0000000..d156910
--- /dev/null
+++ b/src/protocol/oBus_info.ml
@@ -0,0 +1,34 @@
+(*
+ * oBus_info.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(info)"
+
+let version = OBus_config.version
+
+let protocol_version = 1
+let max_name_length = OBus_protocol.max_name_length
+let max_message_size = OBus_protocol.max_message_size
+
+let read_uuid_file file =
+  try%lwt
+    let%lwt line = Lwt_io.with_file ~mode:Lwt_io.input file Lwt_io.read_line in
+    Lwt.return (OBus_uuid.of_string line)
+  with exn ->
+    ignore (Lwt_log.error_f ~section ~exn "failed to read the local machine uuid from file %S" file);
+    Lwt.fail exn
+
+let machine_uuid = lazy(
+  try%lwt
+    read_uuid_file OBus_config.machine_uuid_file
+  with exn ->
+    try%lwt
+      read_uuid_file "/etc/machine-id"
+    with _ ->
+      Lwt.fail exn
+)
diff --git a/src/protocol/oBus_info.mli b/src/protocol/oBus_info.mli
new file mode 100644
index 0000000..1456696
--- /dev/null
+++ b/src/protocol/oBus_info.mli
@@ -0,0 +1,27 @@
+(*
+ * oBus_info.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Various informations *)
+
+val version : string
+  (** version of obus *)
+
+val machine_uuid : OBus_uuid.t Lwt.t Lazy.t
+  (** UUID of the machine we are running on *)
+
+val protocol_version : int
+  (** The version of the D-Bus protocol implemented by the library *)
+
+val max_name_length : int
+  (** Maximum length of a name (=255). This limit applies to bus
+      names, interfaces, and members *)
+
+val max_message_size : int
+  (** Maximum size of a message. In this version of the protocol this
+      is 2^27 bytes (128MB). *)
diff --git a/src/protocol/oBus_interfaces.obus b/src/protocol/oBus_interfaces.obus
new file mode 100644
index 0000000..da5f8bb
--- /dev/null
+++ b/src/protocol/oBus_interfaces.obus
@@ -0,0 +1,76 @@
+(*
+ * oBus_interfaces.obus
+ * --------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+interface org.freedesktop.DBus.Peer {
+  method Ping : () -> ()
+  method GetMachineId : () -> (machine_id : string)
+}
+
+interface org.freedesktop.DBus.Introspectable {
+  method Introspect : () -> (result : string)
+}
+
+interface org.freedesktop.DBus.Properties {
+  method Get : (interface_name : string, member : string) -> (value : variant)
+  method Set : (interface_name : string, member : string, value : variant) -> ()
+  method GetAll : (interface_name : string) -> (values : (string, variant) dict)
+  signal PropertiesChanged : (interface_name : string, updates : (string, variant) dict, invalidates : string array)
+}
+
+interface org.freedesktop.DBus {
+  method Hello : () -> (name : string)
+
+  flag request_name_flags : uint32 {
+    0b001: allow_replacement
+    0b010: replace_existing
+    0b100: do_not_queue
+  }
+
+  enum request_name_result : uint32 {
+    1: primary_owner
+    2: in_queue
+    3: exists
+    4: already_owner
+  }
+
+  method RequestName : (name : string, flags : request_name_flags) -> (result : request_name_result)
+
+  enum release_name_result : uint32 {
+    1: released
+    2: non_existent
+    3: not_owner
+  }
+
+  method ReleaseName : (name : string) -> (result : release_name_result)
+
+  enum start_service_by_name_result : uint32 {
+    1: success
+    2: already_running
+  }
+
+  method StartServiceByName : (name : string, flags : uint32) -> (result : start_service_by_name_result)
+
+  method UpdateActivationEnvironment : (x1 : (string, string) dict) -> ()
+  method NameHasOwner : (x1 : string) -> (x1 : boolean)
+  method ListNames : () -> (x1 : string array)
+  method ListActivatableNames : () -> (x1 : string array)
+  method AddMatch : (x1 : string) -> ()
+  method RemoveMatch : (x1 : string) -> ()
+  method GetNameOwner : (x1 : string) -> (x1 : string)
+  method ListQueuedOwners : (x1 : string) -> (x1 : string array)
+  method GetConnectionUnixUser : (x1 : string) -> (x1 : uint32)
+  method GetConnectionUnixProcessID : (x1 : string) -> (x1 : uint32)
+  method GetAdtAuditSessionData : (x1 : string) -> (x1 : byte array)
+  method GetConnectionSELinuxSecurityContext : (x1 : string) -> (x1 : byte array)
+  method ReloadConfig : () -> ()
+  method GetId : () -> (x1 : string)
+  signal NameOwnerChanged : (x1 : string, x2 : string, x3 : string)
+  signal NameLost : (x1 : string)
+  signal NameAcquired : (x1 : string)
+}
diff --git a/src/protocol/oBus_match.ml b/src/protocol/oBus_match.ml
new file mode 100644
index 0000000..d002460
--- /dev/null
+++ b/src/protocol/oBus_match.ml
@@ -0,0 +1,521 @@
+(*
+ * oBus_match.ml
+ * -------------
+ * Copyright : (c) 2009, 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(match)"
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+type argument_filter =
+  | AF_string of string
+  | AF_string_path of string
+  | AF_namespace of string
+
+type arguments = (int * argument_filter) list
+
+type rule = {
+  typ : [ `Signal | `Error | `Method_call | `Method_return ] option;
+  sender : OBus_name.bus;
+  interface : OBus_name.interface;
+  member : OBus_name.member;
+  path : OBus_path.t option;
+  destination : OBus_name.bus;
+  arguments : arguments;
+  eavesdrop : bool option;
+}
+
+let typ e = e.typ
+let sender e = e.sender
+let interface e = e.interface
+let member e = e.member
+let path e = e.path
+let destination e = e.destination
+let arguments e = e.arguments
+let eavesdrop e = e.eavesdrop
+
+let rule ?typ ?(sender="") ?(interface="") ?(member="") ?path ?(destination="") ?(arguments=[]) ?eavesdrop () = {
+  typ = typ;
+  sender = sender;
+  interface = interface;
+  member = member;
+  path = path;
+  destination = destination;
+  arguments = arguments;
+  eavesdrop = eavesdrop;
+}
+
+(* +-----------------------------------------------------------------+
+   | Arguments lists                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let rec insert_sorted num filter = function
+  | [] -> [(num, filter)]
+  | (num', _) as pair :: rest when num' < num ->
+      pair :: insert_sorted num filter rest
+  | (num', _) :: rest when num' = num ->
+      (num, filter) :: rest
+  | ((num', _) :: rest) as l ->
+      (num, filter) :: l
+
+let make_arguments list =
+  List.fold_left
+    (fun l (num, filter) ->
+       if num < 0 || num > 63 then
+         Printf.ksprintf invalid_arg "OBus_match.arguments_of_list: invalid argument number '%d': it must be in the rane [1..63]" num
+       else
+         insert_sorted num filter l)
+    [] list
+
+external cast_arguments : arguments -> (int * argument_filter) list = "%identity"
+
+(* +-----------------------------------------------------------------+
+   | string <-> rule                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let string_of_rule mr =
+  let buf = Buffer.create 42 in
+  let rec coma = ref (fun _ -> coma := fun _ -> Buffer.add_char buf ',') in
+  let add key value =
+    !coma ();
+    Buffer.add_string buf key;
+    Buffer.add_string buf "='";
+    Buffer.add_string buf value;
+    Buffer.add_char buf '\''
+  in
+  let add_string key test = function
+    | "" -> ()
+    | str ->
+        match test str with
+          | Some error -> raise (OBus_string.Invalid_string error)
+          | None -> add key str
+  in
+  begin
+    match mr.typ with
+      | None -> ()
+      | Some t ->
+          add "type"
+            (match t with
+               | `Method_call -> "method_call"
+               | `Method_return -> "method_return"
+               | `Error -> "error"
+               | `Signal -> "signal")
+  end;
+  add_string "sender" OBus_name.validate_bus mr.sender;
+  add_string "interface" OBus_name.validate_interface mr.interface;
+  add_string "member" OBus_name.validate_member mr.member;
+  begin match mr.path with
+    | None -> ()
+    | Some [] ->
+        !coma ();
+        Buffer.add_string buf "path='/'"
+    | Some p ->
+        !coma ();
+        Buffer.add_string buf "path='";
+        List.iter
+          (fun elt ->
+             match OBus_path.validate_element elt with
+               | Some error ->
+                   raise (OBus_string.Invalid_string error)
+               | None ->
+                   Buffer.add_char buf '/';
+                   Buffer.add_string buf elt)
+          p;
+        Buffer.add_char buf '\''
+  end;
+  add_string "destination" OBus_name.validate_bus mr.destination;
+  List.iter (fun (n, filter) ->
+               !coma ();
+               match filter with
+                 | AF_string str ->
+                     Printf.bprintf buf "arg%d='%s'" n str
+                 | AF_string_path str ->
+                     Printf.bprintf buf "arg%dpath='%s'" n str
+                 | AF_namespace str ->
+                     Printf.bprintf buf "arg%dnamespace='%s'" n str) mr.arguments;
+  begin match mr.eavesdrop with
+    | None -> ()
+    | Some true -> add "eavesdrop" "true"
+    | Some false -> add "eavesdrop" "false"
+  end;
+  Buffer.contents buf
+
+exception Parse_failure of string * int * string
+
+let () =
+  Printexc.register_printer
+    (function
+       | Parse_failure(str, pos, reason) ->
+           Some(Printf.sprintf "failed to parse D-Bus matching rule %S, at position %d: %s" str pos reason)
+       | _ ->
+           None)
+
+exception Fail = OBus_match_rule_lexer.Fail
+
+let rule_of_string str =
+  try
+    let l = match str with
+      | "" -> []
+      | _ -> OBus_match_rule_lexer.match_rules (Lexing.from_string str)
+    in
+    let check pos validate value =
+      match validate value with
+        | None ->
+            ()
+        | Some err ->
+            raise (Fail(pos, OBus_string.error_message err))
+    in
+    let mr = {
+      typ = None;
+      sender = "";
+      interface = "";
+      member = "";
+      path = None;
+      destination = "";
+      arguments = [];
+      eavesdrop = None;
+    } in
+    List.fold_left begin fun mr (pos, key, value) ->
+      match key with
+        | "type" ->
+            { mr with typ = Some(match value with
+                                   | "method_call" -> `Method_call
+                                   | "method_return" -> `Method_return
+                                   | "signal" -> `Signal
+                                   | "error" -> `Error
+                                   | _ -> raise (Fail(pos, Printf.sprintf "invalid message type (%s)" value))) }
+        | "sender" ->
+            check pos OBus_name.validate_bus value;
+            { mr with sender = value }
+        | "destination" ->
+            check pos OBus_name.validate_bus value;
+            { mr with destination = value }
+        | "interface" ->
+            check pos OBus_name.validate_interface value;
+            { mr with interface = value }
+        | "member" ->
+            check pos OBus_name.validate_member value;
+            { mr with member = value }
+        | "path" -> begin
+            try
+              { mr with path = Some(OBus_path.of_string value) }
+            with OBus_string.Invalid_string err ->
+              raise (Fail(pos, OBus_string.error_message err))
+          end
+        | "eavesdrop" -> begin
+            match value with
+              | "true" -> { mr with eavesdrop = Some true }
+              | "false" -> { mr with eavesdrop = Some false }
+              | _ -> raise (Fail(pos, Printf.sprintf "invalid value for eavesdrop (%s)" value))
+          end
+        | _ ->
+            match OBus_match_rule_lexer.arg (Lexing.from_string key) with
+              | Some(n, kind) ->
+                  { mr with arguments =
+                      insert_sorted n
+                        (match kind with
+                           | `String -> AF_string value
+                           | `Path -> AF_string_path value
+                           | `Namespace -> AF_namespace value)
+                        mr.arguments }
+              | None ->
+                  raise (Fail(pos, Printf.sprintf "invalid key (%s)" key))
+    end mr l
+  with Fail(pos, msg) ->
+    raise (Parse_failure(str, pos, msg))
+
+(* +-----------------------------------------------------------------+
+   | Matching                                                        |
+   +-----------------------------------------------------------------+ *)
+
+let match_key matcher value = match matcher with
+  | None -> true
+  | Some value' -> value = value'
+
+let match_string matcher value = match matcher with
+  | "" -> true
+  | value' -> value = value'
+
+let starts_with str prefix =
+  let str_len = String.length str and prefix_len = String.length prefix in
+  let rec loop i =
+    (i = prefix_len) || (i < str_len && str.[i] = prefix.[i] && loop (i + 1))
+  in
+  loop 0
+
+let ends_with_slash str = str <> "" && str.[String.length str - 1] = '/'
+
+let rec match_arguments num matcher arguments = match matcher with
+  | [] ->
+      true
+  | (num', filter) :: rest ->
+      match_arguments_aux num num' filter rest arguments
+
+and match_arguments_aux num num' filter matcher arguments = match arguments with
+  | [] ->
+      false
+  | value :: rest when num < num' ->
+      match_arguments_aux (num + 1) num' filter matcher rest
+  | OBus_value.V.Basic(OBus_value.V.String value) :: rest ->
+      (match filter with
+         | AF_string str ->
+             str = value
+         | AF_string_path str ->
+             (str = value)
+             || (ends_with_slash str && starts_with value str)
+             || (ends_with_slash value && starts_with str value)
+         | AF_namespace str ->
+             starts_with value str &&
+               (String.length value = String.length str ||
+                   value.[String.length str] = '.'))
+      &&  match_arguments (num + 1) matcher rest
+  | OBus_value.V.Basic(OBus_value.V.Object_path value) :: rest ->
+      (match filter with
+         | AF_string str ->
+             false
+         | AF_string_path str ->
+             let value = OBus_path.to_string value in
+             (str = value)
+             || (ends_with_slash str && starts_with value str)
+             || (ends_with_slash value && starts_with str value)
+         | AF_namespace _ ->
+             false)
+      &&  match_arguments (num + 1) matcher rest
+  | _ ->
+      false
+
+let match_values filters values =
+  match_arguments 0 filters values
+
+let match_message mr msg =
+  (match OBus_message.typ msg, mr.typ with
+     | OBus_message.Method_call(path, interface, member), (Some `Method_call | None) ->
+         (match_key mr.path path) &&
+           (match_string mr.interface interface) &&
+           (match_string mr.member member)
+     | OBus_message.Method_return serial, (Some `Method_return | None)->
+         true
+     | OBus_message.Signal(path, interface, member), (Some `Signal | None) ->
+         (match_key mr.path path) &&
+           (match_string mr.interface interface) &&
+           (match_string mr.member member)
+     | OBus_message.Error(serial, name), (Some `Error | None) ->
+         true
+     | _ ->
+         false) &&
+    (match_string mr.sender (OBus_message.sender msg)) &&
+    (match_string mr.destination (OBus_message.destination msg)) &&
+    (match_arguments 0 mr.arguments (OBus_message.body msg))
+
+(* +-----------------------------------------------------------------+
+   | Comparison                                                      |
+   +-----------------------------------------------------------------+ *)
+
+type comparison_result =
+  | More_general
+  | Less_general
+  | Equal
+  | Incomparable
+
+let rec compare_arguments acc l1 l2 =
+  match acc, l1, l2 with
+    | acc, [], [] ->
+        acc
+    | (Less_general | Equal), _ :: _, [] ->
+        Less_general
+    | (More_general | Equal), [], _ :: _ ->
+        More_general
+    | acc, (pos1, filter1) :: rest1, (pos2, filter2) :: rest2 ->
+        if pos1 = pos2 && filter1 = filter2 then
+          compare_arguments acc rest1 rest2
+        else if pos1 < pos2 && (acc = Less_general || acc = Equal) then
+          compare_arguments Less_general rest1 l2
+        else if pos1 > pos2 && (acc = More_general || acc = Equal) then
+          compare_arguments More_general l1 rest2
+        else
+          raise Exit
+    | _ ->
+        raise Exit
+
+let compare_option acc x1 x2 =
+  if x1 = x2 then
+    acc
+  else
+    match acc, x1, x2 with
+      | (Less_general | Equal), Some _, None ->
+          Less_general
+      | (More_general | Equal), None, Some _ ->
+          More_general
+      | _ ->
+          raise Exit
+
+let compare_string acc x1 x2 =
+  if x1 = x2 then
+    acc
+  else
+    match acc, x1, x2 with
+      | (Less_general | Equal), x, "" when x <> "" ->
+          Less_general
+      | (More_general | Equal), "", x when x <> "" ->
+          More_general
+      | _ ->
+          raise Exit
+
+let compare_rules r1 r2 =
+  try
+    if r1.typ = r2.typ then begin
+      let acc = Equal in
+      let acc = compare_string acc r1.sender r2.sender in
+      let acc = compare_string acc r1.destination r2.destination in
+      let acc = compare_option acc r1.path r2.path in
+      let acc = compare_string acc r1.interface r2.interface in
+      let acc = compare_string acc r1.member r2.member in
+      let acc = compare_arguments acc r1.arguments r2.arguments in
+      if r1.eavesdrop = r2.eavesdrop then
+        acc
+      else
+        match acc, r1.eavesdrop, r2.eavesdrop with
+          | _, None, Some false ->
+              acc
+          | _, Some false, None ->
+              acc
+          | (Less_general | Equal), (None | Some false), Some true ->
+              Less_general
+          | (More_general | Equal), Some true, (None | Some false) ->
+              More_general
+          | _ ->
+              Incomparable
+    end else
+      Incomparable
+  with Exit ->
+    Incomparable
+
+(* +-----------------------------------------------------------------+
+   | Exporting rules on message buses                                |
+   +-----------------------------------------------------------------+ *)
+
+module String_set = Set.Make(String)
+
+(* Informations stored in connections *)
+type info = {
+  mutable exported : String_set.t;
+  (* Rules that are currently exported on the message bus (as strings) *)
+
+  mutable rules : rule list;
+  (* The list of all rules we want to export *)
+
+  connection : OBus_connection.t;
+  (* The connection on which the rules are exported *)
+
+  mutex : Lwt_mutex.t;
+  (* Mutex to prevent concurrent modifications of rules *)
+}
+
+(* Add a matching rule to a list of incomparable most general rules *)
+let rec insert_rule rule rules =
+  match rules with
+    | [] ->
+        [rule]
+    | rule' :: rest ->
+        match compare_rules rule rule' with
+          | Incomparable ->
+              rule' :: insert_rule rule rest
+          | Equal | Less_general ->
+              rules
+          | More_general ->
+              rule :: rest
+
+let do_export info rule_string =
+  let%lwt () =
+    OBus_connection.method_call
+      ~connection:info.connection
+      ~destination:OBus_protocol.bus_name
+      ~path:OBus_protocol.bus_path
+      ~interface:OBus_protocol.bus_interface
+      ~member:"AddMatch"
+      ~i_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
+      ~o_args:OBus_value.C.seq0
+      rule_string
+  in
+  info.exported <- String_set.add rule_string info.exported;
+  Lwt.return ()
+
+let do_remove info rule_string =
+  info.exported <- String_set.remove rule_string info.exported;
+  try%lwt
+    OBus_connection.method_call
+      ~connection:info.connection
+      ~destination:OBus_protocol.bus_name
+      ~path:OBus_protocol.bus_path
+      ~interface:OBus_protocol.bus_interface
+      ~member:"RemoveMatch"
+      ~i_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
+      ~o_args:OBus_value.C.seq0
+      rule_string
+  with exn ->
+    match OBus_error.name exn with
+      | "org.freedesktop.DBus.Error.MatchRuleNotFound" ->
+          Lwt_log.info_f ~section "rule %S does not exists on the message bus" rule_string
+      | _ ->
+          Lwt.fail exn
+
+(* Commits rules changes on the message bus: *)
+let commit info =
+  Lwt_mutex.with_lock info.mutex
+    (fun () ->
+       (* Computes the set of most general rules: *)
+       let rules = List.fold_left (fun acc rule -> insert_rule rule acc) [] info.rules in
+
+       (* Turns them into a set of strings: *)
+       let rules = List.fold_left (fun acc rule -> String_set.add (string_of_rule rule) acc) String_set.empty rules in
+
+       (* Computes the minimal set of operations to update the rules: *)
+       let new_rules = String_set.diff rules info.exported
+       and old_rules = String_set.diff info.exported rules in
+
+       (* Does the update of rules on the message bus: *)
+       let threads = [] in
+       let threads = String_set.fold (fun rule acc -> do_export info rule :: acc) new_rules threads in
+       let threads = String_set.fold (fun rule acc -> do_remove info rule :: acc) old_rules threads in
+
+       Lwt.join threads)
+
+let key = OBus_connection.new_key ()
+
+let rec remove_first x l =
+  match l with
+    | [] -> []
+    | x' :: l when x = x' -> l
+    | x' :: l -> x' :: remove_first x l
+
+let export ?switch connection rule =
+  Lwt_switch.check switch;
+  let info =
+    match OBus_connection.get connection key with
+      | Some info ->
+          info
+      | None ->
+          let info = {
+            exported = String_set.empty;
+            connection = connection;
+            rules = [];
+            mutex = Lwt_mutex.create ();
+          } in
+          OBus_connection.set connection key (Some info);
+          info
+  in
+  info.rules <- rule :: info.rules;
+  let%lwt () = commit info in
+  let%lwt () =
+    Lwt_switch.add_hook_or_exec switch
+      (fun () ->
+         info.rules <- remove_first rule info.rules;
+         commit info)
+  in
+  Lwt.return ()
diff --git a/src/protocol/oBus_match.mli b/src/protocol/oBus_match.mli
new file mode 100644
index 0000000..c6884d6
--- /dev/null
+++ b/src/protocol/oBus_match.mli
@@ -0,0 +1,141 @@
+(*
+ * oBus_match.mli
+ * --------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Matching rules *)
+
+(** {6 Rules} *)
+
+(** Type of an argument filter. Argument filters are used in match
+    rules to match message arguments. *)
+type argument_filter =
+  | AF_string of string
+      (** [AF_string str] matches any string argument which is equal
+          to [str] *)
+  | AF_string_path of string
+      (** [AF_string_path path] matches any string or object-path
+          argument [arg] such that one of the following conditions
+          hold:
+
+          - [arg] is equal to [path]
+          - [path] ends with ['/'] and is a prefix of [arg]
+          - [arg] ends with ['/'] and is a prefix of [path] *)
+  | AF_namespace of string
+      (** [AF_namespace namespace] matches any string argument [arg]
+          such that [arg] is a bus or interface name in the namespace of
+          [namespace]. For example [AF_namespace "a.b.c"] matches any
+          string of the form ["a.b.c"], ["a.b.c.foo"],
+          ["a.b.c.foo.bar"], ... *)
+
+type arguments = private (int * argument_filter) list
+    (** Type of lists of argument filters. The private type ensures
+        that such lists are always sorted by argument number, do not
+        contain duplicates and indexes are in the range [0..63].. *)
+
+val make_arguments : (int * argument_filter) list -> arguments
+  (** Creates an arguments filter from a list of filters. It raises
+      [Invalid_argument] if one of the argument filters use a number
+      outside of the range [1..63] *)
+
+external cast_arguments : arguments -> (int * argument_filter) list = "%identity"
+  (** Returns the list of filters for the given arguments filter. *)
+
+(** Type of a rule used to match a message *)
+type rule = {
+  typ : [ `Signal | `Error | `Method_call | `Method_return ] option;
+  sender : OBus_name.bus;
+  interface : OBus_name.interface;
+  member : OBus_name.member;
+  path : OBus_path.t option;
+  destination : OBus_name.bus;
+  arguments : arguments;
+  eavesdrop : bool option;
+}
+
+(** {8 Rule projections} *)
+
+val typ : rule -> [ `Signal | `Error | `Method_call | `Method_return ] option
+val sender : rule -> OBus_name.bus
+val interface : rule -> OBus_name.interface
+val member : rule -> OBus_name.member
+val path : rule -> OBus_path.t option
+val destination : rule -> OBus_name.bus
+val arguments : rule -> arguments
+val eavesdrop : rule -> bool option
+
+(** {8 Rule construction} *)
+
+val rule :
+  ?typ : [ `Signal | `Error | `Method_call | `Method_return ] ->
+  ?sender : OBus_name.bus ->
+  ?interface : OBus_name.interface ->
+  ?member : OBus_name.member ->
+  ?path : OBus_path.t ->
+  ?destination : OBus_name.bus ->
+  ?arguments : arguments ->
+  ?eavesdrop : bool ->
+  unit -> rule
+    (** Create a matching rule. *)
+
+(** {6 Matching} *)
+
+val match_message : rule -> OBus_message.t -> bool
+  (** [match_message rule message] returns wether [message] is matched
+      by [rule] *)
+
+val match_values : arguments -> OBus_value.V.sequence -> bool
+  (** [match_values filters values] returns whether [values] are
+      matched by the given list of argument filters. *)
+
+(** {6 Comparison} *)
+
+(** Result of the comparisong of two rules [r1] and [r2]: *)
+type comparison_result =
+  | More_general
+      (** [r1] is more general than [r2], i.e. any message matched by
+          [r2] is also matched by [r1] *)
+  | Less_general
+      (** [r1] is less general than [r2], i.e. any message matched by
+          [r1] is also matched by [r2] *)
+  | Equal
+      (** [r1] and [r2] are equal *)
+  | Incomparable
+      (** [r1] and [r2] are incomparable, i.e. there exists two
+          message [m1] and [m2] such that:
+
+          - [m1] is matched by [r1] but not by [r2]
+          - [m2] is matched by [r2] but not by [r1]
+      *)
+
+val compare_rules : rule -> rule -> comparison_result
+  (** [compare_rules r1 r2] compares the two matching rules [r1] and
+      [r2] *)
+
+(** {6 Parsing/printing} *)
+
+exception Parse_failure of string * int * string
+  (** [Parse_failure(string, position, reason)] is raised when parsing
+      a rule failed *)
+
+val string_of_rule : rule -> string
+  (** Returns a string representation of a matching rule. *)
+
+val rule_of_string : string -> rule
+  (** Parse a string representation of a matching rule.
+
+      @raise Failure if the given string does not contain a valid
+      matching rule. *)
+
+(** {6 Rules and message buses} *)
+
+val export : ?switch : Lwt_switch.t -> OBus_connection.t -> rule -> unit Lwt.t
+  (** [export ?switch connection rule] registers [rule] on the message
+      bus. If another rule more general than [rule] is already
+      exported, then it does nothihng.
+
+      You can provide a switch to manually disable the export. *)
diff --git a/src/protocol/oBus_match_rule_lexer.mll b/src/protocol/oBus_match_rule_lexer.mll
new file mode 100644
index 0000000..8f5ae2b
--- /dev/null
+++ b/src/protocol/oBus_match_rule_lexer.mll
@@ -0,0 +1,60 @@
+(*
+ * oBus_match_rule_lexer.mll
+ * -------------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+{
+  exception Fail of int * string
+
+  let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum
+
+  let fail lexbuf fmt =
+    Printf.ksprintf
+      (fun msg -> raise (Fail(pos lexbuf, msg)))
+      fmt
+}
+
+rule match_rules = parse
+    | (['a'-'z' '_' '0'-'9']+ as key) "='" ([^ '\'']* as value) '\''
+        { if comma lexbuf then
+            (pos lexbuf, key, value) :: match_rules lexbuf
+          else begin
+            check_eof lexbuf;
+            [(pos lexbuf, key, value)]
+          end }
+    | "=" {
+        fail lexbuf "empty key"
+      }
+    | eof {
+        fail lexbuf "match rule expected"
+      }
+    | _ as ch {
+        fail lexbuf "invalid character %C" ch
+      }
+
+and comma = parse
+    | ',' { true }
+    | ""  { false }
+
+and check_eof = parse
+    | eof { () }
+    | _ as ch { fail lexbuf "invalid character %C" ch }
+
+and arg = parse
+  | "arg" (['0'-'9']+ as n) (("" | "path" | "namespace") as kind) eof {
+        let n = int_of_string n in
+        if n >= 0 && n <= 63 then
+          Some(n,
+               match kind with
+                 | "" -> `String
+                 | "path" -> `Path
+                 | "namespace" -> `Namespace
+                 | _ -> assert false)
+        else
+          fail lexbuf "invalid argument number '%d': it must be between 0 and 63" n
+      }
+  | "" { None }
diff --git a/src/protocol/oBus_member.ml b/src/protocol/oBus_member.ml
new file mode 100644
index 0000000..e4c7e9c
--- /dev/null
+++ b/src/protocol/oBus_member.ml
@@ -0,0 +1,111 @@
+(*
+ * oBus_member.ml
+ * --------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open OBus_introspect
+
+let introspect_arguments args =
+  List.map2
+    (fun name typ -> (name, typ))
+    (OBus_value.arg_names args)
+    (OBus_value.C.type_sequence (OBus_value.arg_types args))
+
+module Method =
+struct
+  type ('a, 'b) t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    i_args : 'a OBus_value.arguments;
+    o_args : 'b OBus_value.arguments;
+    annotations : OBus_introspect.annotation list;
+  }
+
+  let make ~interface ~member ~i_args ~o_args ~annotations = {
+    interface = interface;
+    member = member;
+    i_args = i_args;
+    o_args = o_args;
+    annotations = annotations;
+  }
+
+  let interface m = m.interface
+  let member m = m.member
+  let i_args m = m.i_args
+  let o_args m = m.o_args
+  let annotations m = m.annotations
+
+  let introspect m =
+    Method(m.member, introspect_arguments m.i_args, introspect_arguments m.o_args, m.annotations)
+end
+
+module Signal =
+struct
+  type 'a t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    args : 'a OBus_value.arguments;
+    annotations : OBus_introspect.annotation list;
+  }
+
+  let make ~interface ~member ~args ~annotations = {
+    interface = interface;
+    member = member;
+    args = args;
+    annotations = annotations;
+  }
+
+  let interface s = s.interface
+  let member s = s.member
+  let args s = s.args
+  let annotations s = s.annotations
+
+  let introspect s =
+    Signal(s.member, introspect_arguments s.args, s.annotations)
+end
+
+module Property =
+struct
+  type 'a access =
+    | Readable
+    | Writable
+    | Readable_writable
+
+  let readable = Readable
+  let writable = Writable
+  let readable_writable = Readable_writable
+
+  type ('a, 'access) t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    typ : 'a OBus_value.C.single;
+    access : 'access access;
+    annotations : OBus_introspect.annotation list;
+  }
+
+  let make ~interface ~member ~typ ~access ~annotations = {
+    interface = interface;
+    member = member;
+    typ = typ;
+    access = access;
+    annotations = annotations;
+  }
+
+  let interface p = p.interface
+  let member p = p.member
+  let typ p = p.typ
+  let access p = p.access
+  let annotations p = p.annotations
+
+  let introspect p =
+    Property(p.member, OBus_value.C.type_single p.typ,
+             (match p.access with
+                | Readable -> Read
+                | Writable -> Write
+                | Readable_writable -> Read_write),
+             p.annotations)
+end
diff --git a/src/protocol/oBus_member.mli b/src/protocol/oBus_member.mli
new file mode 100644
index 0000000..f901d1f
--- /dev/null
+++ b/src/protocol/oBus_member.mli
@@ -0,0 +1,133 @@
+(*
+ * oBus_member.mli
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus members description *)
+
+(** D-Bus Methods *)
+module Method : sig
+
+  (** D-Bus method description *)
+
+  (** Type of a method description *)
+  type ('a, 'b) t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    i_args : 'a OBus_value.arguments;
+    (** Input arguments *)
+    o_args : 'b OBus_value.arguments;
+    (** Output arguments *)
+    annotations : OBus_introspect.annotation list;
+  }
+
+  (** {6 Creation} *)
+
+  val make :
+    interface : OBus_name.interface ->
+    member : OBus_name.member ->
+    i_args : 'a OBus_value.arguments ->
+    o_args : 'b OBus_value.arguments ->
+    annotations : OBus_introspect.annotation list -> ('a, 'b) t
+
+  (** {6 Projections} *)
+
+  val interface : ('a, 'b) t -> OBus_name.interface
+  val member : ('a, 'b) t -> OBus_name.member
+  val i_args : ('a, 'b) t -> 'a OBus_value.arguments
+  val o_args : ('a, 'b) t -> 'b OBus_value.arguments
+  val annotations : ('a, 'b) t -> OBus_introspect.annotation list
+
+  (** {6 Introspection} *)
+
+  val introspect : ('a, 'b) t -> OBus_introspect.member
+end
+
+(** D-Bus signals *)
+module Signal : sig
+
+  (** D-Bus signal description *)
+
+  (** Type of a signal description *)
+  type 'a t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    args : 'a OBus_value.arguments;
+    annotations : OBus_introspect.annotation list;
+  }
+
+  (** {6 Creation} *)
+
+  val make :
+    interface : OBus_name.interface ->
+    member : OBus_name.member ->
+    args : 'a OBus_value.arguments ->
+    annotations : OBus_introspect.annotation list -> 'a t
+
+  (** {6 Projections} *)
+
+  val interface : 'a t -> OBus_name.interface
+  val member : 'a t -> OBus_name.member
+  val args : 'a t -> 'a OBus_value.arguments
+  val annotations : 'a t -> OBus_introspect.annotation list
+
+  (** {6 Introspection} *)
+
+  val introspect : 'a t -> OBus_introspect.member
+end
+
+(** D-Bus properties *)
+module Property : sig
+
+  (** D-Bus property description *)
+
+  (** Type of access modes *)
+  type 'a access =
+      private
+    | Readable
+    | Writable
+    | Readable_writable
+
+  val readable : [ `readable ] access
+    (** Access mode for readable properties *)
+
+  val writable : [ `writable ] access
+    (** Access mode for writable properties *)
+
+  val readable_writable : [ `readable | `writable ] access
+    (** Access mode for readable and writable properties *)
+
+  (** Type of a property description *)
+  type ('a, 'access) t = {
+    interface : OBus_name.interface;
+    member : OBus_name.member;
+    typ : 'a OBus_value.C.single;
+    access : 'access access;
+    annotations : OBus_introspect.annotation list;
+  }
+
+  (** {6 Creation} *)
+
+  val make :
+    interface : OBus_name.interface ->
+    member : OBus_name.member ->
+    typ : 'a OBus_value.C.single ->
+    access : 'access access ->
+    annotations : OBus_introspect.annotation list -> ('a, 'access) t
+
+  (** {6 Projections} *)
+
+  val interface : ('a, 'access) t -> OBus_name.interface
+  val member : ('a, 'access) t -> OBus_name.member
+  val typ : ('a, 'access) t -> 'a OBus_value.C.single
+  val access : ('a, 'access) t -> 'access access
+  val annotations : ('a, 'access) t -> OBus_introspect.annotation list
+
+  (** {6 Introspection} *)
+
+  val introspect : ('a, 'access) t -> OBus_introspect.member
+end
diff --git a/src/protocol/oBus_message.ml b/src/protocol/oBus_message.ml
new file mode 100644
index 0000000..9a33ba5
--- /dev/null
+++ b/src/protocol/oBus_message.ml
@@ -0,0 +1,136 @@
+(*
+ * oBus_message.ml
+ * ---------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+type serial = int32
+type body = OBus_value.V.sequence
+
+type flags = {
+  no_reply_expected : bool;
+  no_auto_start : bool;
+}
+
+let no_reply_expected flags = flags.no_reply_expected
+let no_auto_start flags = flags.no_auto_start
+
+let  default_flags = {
+  no_reply_expected = false;
+  no_auto_start = false;
+}
+
+let make_flags ?(no_reply_expected=false) ?(no_auto_start=false) () = {
+  no_reply_expected = no_reply_expected;
+  no_auto_start = no_auto_start;
+}
+
+type typ =
+  | Method_call of OBus_path.t * OBus_name.interface * OBus_name.member
+  | Method_return of serial
+  | Error of serial * OBus_name.error
+  | Signal of OBus_path.t * OBus_name.interface * OBus_name.member
+
+type t = {
+  flags : flags;
+  serial : serial;
+  typ : typ;
+  destination : OBus_name.bus;
+  sender : OBus_name.bus;
+  body : body;
+}
+
+let flags m = m.flags
+let serial m = m.serial
+let typ m = m.typ
+let destination m = m.destination
+let sender m = m.sender
+let body m = m.body
+
+let make ?(flags=default_flags) ?(serial=0l) ?(sender="") ?(destination="") ~typ body =
+  { flags = flags;
+    serial = serial;
+    typ = typ;
+    destination = destination;
+    sender = sender;
+    body = body }
+
+let method_call ?flags ?serial ?sender ?destination ~path ?(interface="") ~member body =
+  make ?flags  ?serial ?sender ?destination ~typ:(Method_call(path, interface, member)) body
+
+let method_return ?flags ?serial ?sender ?destination ~reply_serial body =
+  make ?flags ?serial ?sender ?destination ~typ:(Method_return(reply_serial)) body
+
+let error ?flags ?serial ?sender ?destination ~reply_serial ~error_name body =
+  make ?flags ?serial ?sender ?destination ~typ:(Error(reply_serial, error_name)) body
+
+let signal ?flags ?serial ?sender ?destination ~path ~interface ~member body =
+  make ?flags ?serial ?sender ?destination ~typ:(Signal(path, interface, member)) body
+
+exception Invalid_reply of string
+
+let invalid_reply ~method_call ~expected_signature ~method_return =
+  match method_call, method_return with
+    | { typ = Method_call(path, interface, member) }, { typ = Method_return _; body } ->
+        Invalid_reply
+          (Printf.sprintf
+             "unexpected signature for the reply to the method %S on interface %S, expected: %S, got: %S"
+             member
+             interface
+             (OBus_value.string_of_signature expected_signature)
+             (OBus_value.string_of_signature (OBus_value.V.type_of_sequence body)))
+    | _ ->
+        invalid_arg "OBus_message.invalid_reply"
+
+open Format
+open OBus_value
+
+let print pp message =
+  fprintf pp
+    "no_reply_expected = %B@\n\
+     no_auto_start = %B@\n\
+     serial = %ld@\n\
+     message_type = %a@\n\
+     sender = %S@\n\
+     destination = %S@\n\
+     signature = %S@\n\
+     body_type = %a@\n\
+     body = %a@\n"
+    message.flags.no_reply_expected
+    message.flags.no_auto_start
+    message.serial
+    (fun pp -> function
+       | Method_call(path, interface, member) ->
+           fprintf pp
+             "method_call@\n\
+              path = %S@\n\
+              interface = %S@\n\
+              member = %S"
+             (OBus_path.to_string path) interface member
+       | Method_return reply_serial ->
+           fprintf pp
+             "method_return@\n\
+              reply_serial = %ld"
+             reply_serial
+       | Error(reply_serial, error_name) ->
+           fprintf pp
+             "error@\n\
+              reply_serial = %ld@\n\
+              error_name = %S"
+             reply_serial error_name
+       | Signal(path, interface, member) ->
+           fprintf pp
+             "signal@\n\
+              path = %S@\n\
+              interface = %S@\n\
+              member = %S"
+             (OBus_path.to_string path) interface member)
+    message.typ
+    message.sender
+    message.destination
+    (string_of_signature (V.type_of_sequence message.body))
+    T.print_sequence (V.type_of_sequence message.body)
+    V.print_sequence message.body
diff --git a/src/protocol/oBus_message.mli b/src/protocol/oBus_message.mli
new file mode 100644
index 0000000..a56dae5
--- /dev/null
+++ b/src/protocol/oBus_message.mli
@@ -0,0 +1,131 @@
+(*
+ * oBus_message.mli
+ * ----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Message description *)
+
+type serial = int32
+
+(** {6 Message structure} *)
+
+type body = OBus_value.V.sequence
+    (** The body is a sequence of dynamically typed values *)
+
+type typ =
+  | Method_call of OBus_path.t * OBus_name.interface * OBus_name.member
+  | Method_return of serial
+  | Error of serial * OBus_name.error
+  | Signal of OBus_path.t * OBus_name.interface * OBus_name.member
+
+(** flags *)
+type flags = {
+  no_reply_expected : bool;
+  no_auto_start : bool;
+}
+
+val no_reply_expected : flags -> bool
+  (** [no_reply_expected] projection *)
+
+val no_auto_start : flags -> bool
+  (** [no_auto_start] projection *)
+
+val make_flags : ?no_reply_expected:bool -> ?no_auto_start:bool -> unit -> flags
+  (** Creates message flags. All optional arguments default to
+      [false] *)
+
+val default_flags : flags
+  (** All false *)
+
+type t = {
+  flags : flags;
+  serial : serial;
+  typ : typ;
+  destination : OBus_name.bus;
+  sender : OBus_name.bus;
+  body : body;
+}
+
+(** {8 Projections} *)
+
+val flags : t -> flags
+val serial : t -> serial
+val typ : t -> typ
+val destination : t -> OBus_name.bus
+val sender : t -> OBus_name.bus
+val body : t -> body
+
+(** {6 Helpers for creating messages} *)
+
+(** Note that when creating a message the serial field is not
+    relevant, it is overridden by {!OBus_connection} at
+    sending-time *)
+
+val make :
+  ?flags : flags ->
+  ?serial : serial ->
+  ?sender : OBus_name.bus ->
+  ?destination : OBus_name.bus ->
+  typ : typ ->
+  body -> t
+
+val method_call :
+  ?flags : flags ->
+  ?serial : serial ->
+  ?sender : OBus_name.bus ->
+  ?destination : OBus_name.bus ->
+  path : OBus_path.t ->
+  ?interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  body -> t
+
+val method_return :
+  ?flags : flags ->
+  ?serial : serial ->
+  ?sender : OBus_name.bus ->
+  ?destination : OBus_name.bus ->
+  reply_serial : serial ->
+  body -> t
+
+val error :
+  ?flags : flags ->
+  ?serial : serial ->
+  ?sender : OBus_name.bus ->
+  ?destination : OBus_name.bus ->
+  reply_serial : serial ->
+  error_name : OBus_name.error ->
+  body -> t
+
+val signal :
+  ?flags : flags ->
+  ?serial : serial ->
+  ?sender : OBus_name.bus ->
+  ?destination : OBus_name.bus ->
+  path : OBus_path.t ->
+  interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  body -> t
+
+(** {6 Errors} *)
+
+exception Invalid_reply of string
+  (** Exception raised when the signature of the reply to a method
+      call does not match the expected signature. The argument is an
+      error message. *)
+
+val invalid_reply : method_call : t -> expected_signature : OBus_value.signature -> method_return : t -> exn
+  (** [invalid_reply ~method_call ~expected_signature ~method_return]
+      @return an {!Invalid_reply} exception with a informative
+      description of the error.
+      @raise Invalid_argument if [method_call] is not a method
+      call message or [method_return] is not a method return
+      message *)
+
+(** {6 Pretty-printing} *)
+
+val print : Format.formatter -> t -> unit
+  (** Print a message on a formatter *)
diff --git a/src/protocol/oBus_method.ml b/src/protocol/oBus_method.ml
new file mode 100644
index 0000000..c2133cf
--- /dev/null
+++ b/src/protocol/oBus_method.ml
@@ -0,0 +1,45 @@
+(*
+ * oBus_method.ml
+ * --------------
+ * Copyright : (c) 2010, 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(method)"
+
+let call info proxy args =
+  OBus_connection.method_call
+    ~connection:(OBus_proxy.connection proxy)
+    ~destination:(OBus_proxy.name proxy)
+    ~path:(OBus_proxy.path proxy)
+    ~interface:(OBus_member.Method.interface info)
+    ~member:(OBus_member.Method.member info)
+    ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info))
+    ~o_args:(OBus_value.arg_types (OBus_member.Method.o_args info))
+    args
+
+let call_with_context info proxy args =
+  let%lwt msg, result =
+    OBus_connection.method_call_with_message
+      ~connection:(OBus_proxy.connection proxy)
+      ~destination:(OBus_proxy.name proxy)
+      ~path:(OBus_proxy.path proxy)
+      ~interface:(OBus_member.Method.interface info)
+      ~member:(OBus_member.Method.member info)
+      ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info))
+      ~o_args:(OBus_value.arg_types (OBus_member.Method.o_args info))
+      args
+  in
+  Lwt.return (OBus_context.make (OBus_proxy.connection proxy) msg, result)
+
+let call_no_reply info proxy args =
+  OBus_connection.method_call_no_reply
+    ~connection:(OBus_proxy.connection proxy)
+    ~destination:(OBus_proxy.name proxy)
+    ~path:(OBus_proxy.path proxy)
+    ~interface:(OBus_member.Method.interface info)
+    ~member:(OBus_member.Method.member info)
+    ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info))
+    args
diff --git a/src/protocol/oBus_method.mli b/src/protocol/oBus_method.mli
new file mode 100644
index 0000000..e568411
--- /dev/null
+++ b/src/protocol/oBus_method.mli
@@ -0,0 +1,22 @@
+(*
+ * oBus_method.mli
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus methods *)
+
+val call : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> 'b Lwt.t
+  (** [call meth proxy args] calls the method [meth] on the object
+      pointed by [proxy], and wait for the reply. *)
+
+val call_with_context : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> (OBus_context.t * 'b) Lwt.t
+  (** [call_with_context meth proxy args] is like {!call} except that
+      it also returns the context of the method return *)
+
+val call_no_reply : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> unit Lwt.t
+  (** [call_no_reply meth proxy args] is the same as {!call} except
+      that it does not wait for a reply *)
diff --git a/src/protocol/oBus_object.ml b/src/protocol/oBus_object.ml
new file mode 100644
index 0000000..c0863a0
--- /dev/null
+++ b/src/protocol/oBus_object.ml
@@ -0,0 +1,1014 @@
+(*
+ * oBus_object.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
+
+let section = Lwt_log.Section.make "obus(object)"
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+module Connection_set = Set.Make(OBus_connection)
+module String_set = Set.Make(String)
+module String_map = Map.Make(String)
+module Path_map = Map.Make(OBus_path)
+
+module type Method_info = sig
+  type obj
+  type i_type
+  type o_type
+  val info : (i_type, o_type) OBus_member.Method.t
+  val handler : obj -> i_type -> o_type Lwt.t
+end
+
+module type Signal_info = sig
+  type obj
+  type typ
+  val info : typ OBus_member.Signal.t
+end
+
+module type Property_info = sig
+  type obj
+  type typ
+  type access
+  val info : (typ, access) OBus_member.Property.t
+  val set : (obj -> typ -> unit Lwt.t) option
+  val signal : (obj -> typ signal) option
+end
+
+module type Property_instance = sig
+  type typ
+  type access
+  val info : (typ, access) OBus_member.Property.t
+
+  val signal : typ signal
+    (* The signal holding the current value of the property *)
+
+  val monitor : unit event
+    (* Event which send notifications when the contents of the
+       property changes *)
+end
+
+type property_instance = (module Property_instance)
+
+(* An interface descriptor *)
+type 'a interface = {
+  i_name : OBus_name.interface;
+  (* The name of the interface *)
+
+  i_methods : 'a method_info array;
+  (* Array of methods, for dispatching method calls and introspection *)
+
+  i_signals : 'a signal_info array;
+  (* Array of signals, for introspection *)
+
+  i_properties : 'a property_info array;
+  (* Array of for properties, for reading/writing properties and introspection *)
+
+  i_annotations : OBus_introspect.annotation list;
+  (* List of annotations of the interfaces. They are used for
+     introspection *)
+}
+
+(* D-Bus object informations *)
+and 'a t = {
+  path : OBus_path.t;
+  (* The path of the object *)
+
+  mutable data : 'a option;
+  (* Data attached to the object *)
+
+  exports : Connection_set.t signal;
+  set_exports : Connection_set.t -> unit;
+  (* Set of connection on which the object is exported *)
+
+  owner : OBus_peer.t option;
+  (* The optionnal owner of the object *)
+
+  mutable interfaces : 'a interface array;
+  (* Interfaces implemented by this object *)
+
+  mutable properties : property_instance option array array;
+  (* All property instances of the object *)
+
+  mutable changed : OBus_value.V.single option String_map.t array;
+  (* Properties that changed since the last upadte, organised by
+     interface *)
+
+  properties_changed : (OBus_name.interface -> (OBus_name.member * OBus_value.V.single option) list -> unit Lwt.t) ref;
+  (* Function called when proeprties change. It may emit a
+     notification signal. The default one use
+     [org.freedesktop.DBus.Properties.PropertiesChanged] *)
+}
+
+and 'a method_info = (module Method_info with type obj = 'a t)
+and 'a signal_info = (module Signal_info with type obj = 'a t)
+and 'a property_info = (module Property_info with type obj = 'a t)
+
+(* Signature for static objects *)
+module type Static = sig
+  type data
+    (* Type of data attached to the obejct *)
+
+  val obj : data t
+    (* The object itself *)
+end
+
+type static = (module Static)
+
+(* Signature for dynamic object *)
+module type Dynamic = sig
+  type data
+    (* Type of data attached to obejcts *)
+
+  val get : OBus_context.t -> OBus_path.t -> data t Lwt.t
+end
+
+type dynamic = (module Dynamic)
+
+(* Informations stored in connections *)
+type info = {
+  mutable statics : static Path_map.t;
+  (* Static objects exported on the connection *)
+
+  mutable dynamics : dynamic Path_map.t;
+  (* Dynamic objects exported on the connection *)
+
+  mutable watcher : unit event;
+  (* Event which cleanup things when the connection goes down *)
+}
+
+(* +-----------------------------------------------------------------+
+   | Object parameters                                               |
+   +-----------------------------------------------------------------+ *)
+
+let path obj = obj.path
+let owner obj = obj.owner
+let exports obj = obj.exports
+
+let introspect_args args =
+  List.map2
+    (fun name_opt typ -> (name_opt, typ))
+    (OBus_value.arg_names args)
+    (OBus_value.C.type_sequence (OBus_value.arg_types args))
+
+let introspect_method (type d) info =
+  let module M = (val info : Method_info with type obj = d t) in
+  OBus_member.Method.introspect M.info
+
+let introspect_signal (type d) info =
+  let module S = (val info : Signal_info with type obj = d t) in
+  OBus_member.Signal.introspect S.info
+
+let introspect_property (type d) info =
+  let module P = (val info : Property_info with type obj = d t) in
+  OBus_member.Property.introspect P.info
+
+let introspect obj =
+  Array.fold_right
+    (fun interface acc ->
+       let members = [] in
+       let members = Array.fold_right (fun member acc -> introspect_property member :: acc) interface.i_properties members in
+       let members = Array.fold_right (fun member acc -> introspect_signal member :: acc) interface.i_signals members in
+       let members = Array.fold_right (fun member acc -> introspect_method member :: acc) interface.i_methods members in
+       (interface.i_name, members, interface.i_annotations) :: acc)
+    obj.interfaces []
+
+let on_properties_changed obj = obj.properties_changed
+
+(* +-----------------------------------------------------------------+
+   | Binary search                                                   |
+   +-----------------------------------------------------------------+ *)
+
+let binary_search compare key array =
+  let rec loop a b =
+    if a = b then
+      -1
+    else begin
+      let middle = (a + b) / 2 in
+      let cmp = compare key (Array.unsafe_get array middle) in
+      if cmp = 0 then
+        middle
+      else if cmp < 0 then
+        loop a middle
+      else
+        loop (middle + 1) b
+    end
+  in
+  loop 0 (Array.length array)
+
+let compare_interface name interface =
+  String.compare name interface.i_name
+
+let compare_property (type d) name property =
+  let module P = (val property : Property_info with type obj = d t) in
+  String.compare name P.info.OBus_member.Property.member
+
+let compare_method (type d) name method_ =
+  let module M = (val method_ : Method_info with type obj = d t) in
+  String.compare name M.info.OBus_member.Method.member
+
+(* +-----------------------------------------------------------------+
+   | Dispatching                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let unknown_method interface member arguments =
+  Lwt.fail
+    (OBus_error.Unknown_method
+       (Printf.sprintf
+          "Method %S with signature %S on interface %S does not exist"
+          member
+          (OBus_value.string_of_signature (OBus_value.V.type_of_sequence arguments))
+          interface))
+
+(* Executes a method *)
+let execute (type d) method_info context obj arguments =
+  let module M = (val method_info : Method_info with type obj = d t) in
+  let arguments =
+    try
+      OBus_value.C.cast_sequence
+        (OBus_value.arg_types (OBus_member.Method.i_args M.info))
+        arguments
+    with OBus_value.C.Signature_mismatch ->
+      raise
+        (OBus_error.Failed
+           (Printf.sprintf
+              "invalid signature(%S) for method %S on interface %S, must be %S"
+              (OBus_value.string_of_signature
+                 (OBus_value.V.type_of_sequence arguments))
+              (OBus_member.Method.member M.info)
+              (OBus_member.Method.interface M.info)
+              (OBus_value.string_of_signature
+                 (OBus_value.C.type_sequence
+                    (OBus_value.arg_types
+                       (OBus_member.Method.i_args M.info))))))
+  in
+  Lwt.with_value OBus_context.key (Some context)
+    (fun () ->
+       let%lwt reply = M.handler obj arguments in
+       Lwt.return (OBus_value.C.make_sequence (OBus_value.arg_types (OBus_member.Method.o_args M.info)) reply))
+
+(* Dispatch a method call to the implementation of the method *)
+let dispatch context obj interface member arguments =
+  if interface = "" then
+    let rec loop i =
+      if i = Array.length obj.interfaces then
+        unknown_method interface member arguments
+      else
+        match binary_search compare_method member obj.interfaces.(i).i_methods with
+          | -1 ->
+              loop (i + 1)
+          | index ->
+              execute obj.interfaces.(i).i_methods.(index) context obj arguments
+    in
+    loop 0
+  else
+    match binary_search compare_interface interface obj.interfaces with
+      | -1 ->
+          unknown_method interface member arguments
+      | index ->
+          let interface = obj.interfaces.(index) in
+          match binary_search compare_method member interface.i_methods with
+            | -1 ->
+                unknown_method interface.i_name member arguments
+            | index ->
+                execute interface.i_methods.(index) context obj arguments
+
+(* Search a dynamic node prefix of [path] in [map]: *)
+let search_dynamic path map =
+  Path_map.fold
+    (fun prefix dynamic acc ->
+       match acc with
+         | Some _ ->
+             acc
+         | None ->
+             match OBus_path.after prefix path with
+               | Some path ->
+                   Some(path, dynamic)
+               | None ->
+                   None)
+    map None
+
+let send_reply context value =
+  try%lwt
+    let open OBus_message in
+    OBus_connection.send_message (OBus_context.connection context) {
+      flags = { no_reply_expected = true; no_auto_start = true };
+      serial = 0l;
+      typ = Method_return(OBus_context.serial context);
+      destination = OBus_peer.name (OBus_context.sender context);
+      sender = "";
+      body = value;
+    }
+  with exn ->
+    Lwt_log.warning ~section ~exn "failed to send reply to method call"
+
+let send_error context exn =
+  let name, message = OBus_error.cast exn in
+  try%lwt
+    let open OBus_message in
+    OBus_connection.send_message (OBus_context.connection context) {
+      flags = { no_reply_expected = true; no_auto_start = true };
+      serial = 0l;
+      typ = Error(OBus_context.serial context, name);
+      destination = OBus_peer.name (OBus_context.sender context);
+      sender = "";
+      body = [OBus_value.V.basic_string message];
+    }
+  with exn ->
+    Lwt_log.warning ~section ~exn "failed to send error in reply to method call"
+
+(* Returns the list of children of a node *)
+let children info prefix =
+  String_set.elements
+    (Path_map.fold
+       (fun path obj acc -> match OBus_path.after prefix path with
+          | Some(element :: _) -> String_set.add element acc
+          | _ -> acc)
+       info.statics
+       String_set.empty)
+
+exception No_such_object
+
+(* Handle method call messages *)
+let handle_message connection info message =
+  match message with
+    | { OBus_message.typ = OBus_message.Method_call(path, interface, member) } ->
+        ignore begin
+          let context = OBus_context.make connection message in
+          try%lwt
+            let%lwt reply =
+              (* First, we search the object in static objects *)
+              match try Some(Path_map.find path info.statics) with Not_found -> None with
+                | Some static ->
+                    let module M = (val static : Static) in
+                    dispatch context M.obj interface member (OBus_message.body message)
+                | None ->
+                    (* Then we search in dynamic objects *)
+                    match search_dynamic path info.dynamics with
+                      | None ->
+                          Lwt.fail No_such_object
+                      | Some(path, dynamic) ->
+                          let module M = (val dynamic : Dynamic) in
+                          let%lwt result =
+                            try%lwt
+                              let%lwt obj = M.get context path in
+                              Lwt.return (`Success obj)
+                            with exn ->
+                              Lwt.return (`Failure exn)
+                          in
+                          match result with
+                            | `Success obj ->
+                                dispatch context obj interface member (OBus_message.body message)
+                            | `Failure Not_found ->
+                                Lwt.fail No_such_object
+                            | `Failure exn ->
+                                let%lwt () = Lwt_log.error ~section ~exn "dynamic object handler failed with" in
+                                Lwt.fail No_such_object
+            in
+            send_reply context reply
+          with
+            | No_such_object -> begin
+                (* Handle introspection for missing intermediate object:
+
+                   for example if we have only one exported object
+                   with path "/a/b/c", we need to add introspection
+                   support for virtual objects with path "/", "/a",
+                   "/a/b", "/a/b/c". *)
+                match interface, member, OBus_message.body message with
+                  | ("" | "org.freedesktop.DBus.Introspectable"), "Introspect", [] ->
+                      let buffer = Buffer.create 1024 in
+                      OBus_introspect.output
+                        (Xmlm.make_output ~nl:true ~indent:(Some 2) (`Buffer buffer))
+                        ([], children info path);
+                      send_reply context [OBus_value.V.basic_string (Buffer.contents buffer)]
+                  | _ ->
+                      send_error context (OBus_error.Unknown_object (Printf.sprintf "Object %S does not exists" (OBus_path.to_string path)))
+              end
+            | exn ->
+                let%lwt () =
+                  if OBus_error.name exn = OBus_error.ocaml then
+                    (* It is a bad thing to raise an error that is not
+                       mapped to a D-Bus error, so we alert the
+                       user: *)
+                    Lwt_log.error_f ~section ~exn
+                      "method call handler for method %S on interface %S failed with"
+                      member interface
+                  else
+                    Lwt.return ()
+                in
+                send_error context exn
+        end;
+        Some message
+
+    | _ ->
+        Some message
+
+(* +-----------------------------------------------------------------+
+   | Exportation                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let key = OBus_connection.new_key ()
+
+let cleanup connection info =
+  E.stop info.watcher;
+  Path_map.iter
+    (fun path static ->
+       let module M = (val static : Static) in
+       M.obj.set_exports (Connection_set.remove connection (S.value M.obj.exports)))
+    info.statics
+
+let get_info connection =
+  match OBus_connection.get connection key with
+    | Some info ->
+        info
+    | None ->
+        let info = {
+          statics = Path_map.empty;
+          dynamics = Path_map.empty;
+          watcher = E.never;
+        } in
+        OBus_connection.set connection key (Some info);
+        let _ = Lwt_sequence.add_r (handle_message connection info) (OBus_connection.incoming_filters connection) in
+        info.watcher <- (
+          E.map
+            (fun state -> cleanup connection info)
+            (E.once
+               (S.changes
+                  (OBus_connection.active connection)))
+        );
+        info
+
+let remove connection obj =
+  let exports = S.value obj.exports in
+  if Connection_set.mem connection exports then begin
+    if S.value (OBus_connection.active connection) then begin
+      match OBus_connection.get connection key with
+        | Some info ->
+            info.statics <- Path_map.remove obj.path info.statics
+        | None ->
+            ()
+    end;
+    obj.set_exports (Connection_set.remove connection exports);
+  end
+
+let remove_by_path connection path =
+  if S.value (OBus_connection.active connection) then
+    match OBus_connection.get connection key with
+      | None ->
+          ()
+      | Some info ->
+          info.dynamics <- Path_map.remove path info.dynamics;
+          match try Some(Path_map.find path info.statics) with Not_found -> None with
+            | Some static ->
+                let module M = (val static : Static) in
+                remove connection M.obj
+            | None ->
+                ()
+
+let export (type d) connection obj =
+  if obj.data = None then
+    failwith "OBus_object.export: cannot export an object without data attached"
+  else
+    let exports = S.value obj.exports in
+    if not (Connection_set.mem connection exports) then begin
+      let info = get_info connection in
+      let () =
+        (* Remove any object registered under the same path: *)
+        match try Some(Path_map.find obj.path info.statics) with Not_found -> None with
+          | Some static ->
+              let module M = (val static : Static) in
+              remove connection M.obj
+          | None ->
+              ()
+      in
+      let module M = struct
+        type data = d
+        let obj = obj
+      end in
+      info.statics <- Path_map.add obj.path (module M : Static) info.statics;
+      obj.set_exports (Connection_set.add connection exports)
+    end
+
+let destroy obj =
+  Connection_set.iter (fun connection -> remove connection obj) (S.value obj.exports)
+
+let dynamic (type d) ~connection ~prefix ~handler =
+  let info = get_info connection in
+  let module M = struct
+    type data = d
+    let get = handler
+  end in
+  info.dynamics <- Path_map.add prefix (module M : Dynamic) info.dynamics
+
+(* +-----------------------------------------------------------------+
+   | Signals                                                         |
+   +-----------------------------------------------------------------+ *)
+
+let emit obj ~interface ~member ?peer typ x =
+  let module M = OBus_message in
+  let body = OBus_value.C.make_sequence typ x in
+  match peer, obj.owner with
+    | Some { OBus_peer.connection; OBus_peer.name }, _
+    | _, Some { OBus_peer.connection; OBus_peer.name } ->
+        OBus_connection.send_message connection {
+          M.flags = { M.no_reply_expected = true; M.no_auto_start = true };
+          M.serial = 0l;
+          M.typ = OBus_message.Signal(obj.path, interface, member);
+          M.destination = name;
+          M.sender = "";
+          M.body = body;
+        }
+    | None, None ->
+        let signal = {
+          M.flags = { M.no_reply_expected = true; M.no_auto_start = true };
+          M.serial = 0l;
+          M.typ = OBus_message.Signal(obj.path, interface, member);
+          M.destination = "";
+          M.sender = "";
+          M.body = body;
+        } in
+        Lwt.join (Connection_set.fold
+                    (fun connection l -> OBus_connection.send_message connection signal :: l)
+                    (S.value obj.exports) [])
+
+(* +-----------------------------------------------------------------+
+   | Property change notifications                                   |
+   +-----------------------------------------------------------------+ *)
+
+let notify_properties_change (type d) obj interface_name changed index =
+  (* Sleep a bit, so multiple changes are sent only one time. *)
+  let%lwt () = Lwt.pause () in
+  let members = changed.(index) in
+  changed.(index) <- String_map.empty;
+  try%lwt
+    !(obj.properties_changed)
+      interface_name
+      (String_map.fold (fun name value_opt acc -> (name, value_opt) :: acc) members [])
+  with exn ->
+    Lwt_log.error ~exn ~section "properties_changed callback failed with"
+
+let handle_property_change obj index info value_opt =
+  let empty = String_map.is_empty obj.changed.(index) in
+  obj.changed.(index) <- String_map.add (OBus_member.Property.member info) value_opt obj.changed.(index);
+  if empty then ignore (notify_properties_change obj (OBus_member.Property.interface info) obj.changed index)
+
+let handle_property_change_true (type d) (type v) obj interface_index prop value =
+  let module P = (val prop : Property_info with type obj = d t and type typ = v) in
+  let value = OBus_value.C.make_single (OBus_member.Property.typ P.info) value in
+  handle_property_change obj interface_index P.info (Some value)
+
+let handle_property_change_invalidates (type d) (type v) obj interface_index prop value =
+  let module P = (val prop : Property_info with type obj = d t and type typ = v) in
+  handle_property_change obj interface_index P.info None
+
+(* +-----------------------------------------------------------------+
+   | Property maps genrations                                        |
+   +-----------------------------------------------------------------+ *)
+
+(* Notification mode for a property *)
+type emits_signal_changed =
+  | Esc_default
+      (* Use the default value, which may be defined in the
+         interface *)
+  | Esc_false
+      (* Do not notify property changes *)
+  | Esc_true
+      (* Notify property changes, and send the new contents in the
+         notification *)
+  | Esc_invalidates
+      (* Only send the property name in changes' notifications *)
+
+let get_emits_changed_signal annotations =
+  try
+    match List.assoc OBus_introspect.emits_changed_signal annotations with
+      | "true" -> Esc_true
+      | "false" -> Esc_false
+      | "invalidates" -> Esc_invalidates
+      | value ->
+          ignore (Lwt_log.warning_f "invalid value(%S) for annotation %S. Using default(\"true\")" value OBus_introspect.emits_changed_signal);
+          Esc_true
+  with Not_found ->
+    Esc_default
+
+(* Generate the [properties] field from the [interfaces] field: *)
+let generate (type d) obj =
+  (* Stop monitoring of previous properties *)
+  Array.iter
+    (fun instances ->
+       Array.iter
+         (function
+            | Some instance ->
+                let module M = (val instance : Property_instance) in
+                S.stop M.signal;
+                E.stop M.monitor
+            | None -> ())
+         instances)
+    obj.properties;
+  let count = Array.length obj.interfaces in
+  obj.properties <- Array.make count [||];
+  obj.changed <- Array.make count String_map.empty;
+  for i = 0 to count - 1 do
+    let properties = obj.interfaces.(i).i_properties in
+    let count' = Array.length properties in
+    let instances = Array.make count' None in
+    obj.properties.(i) <- instances;
+    for j = 0 to count' - 1 do
+      let module P = (val properties.(j) : Property_info with type obj = d t) in
+      match P.signal with
+        | Some make ->
+            let module I = struct
+              type typ = P.typ
+              type access = P.access
+              let info = P.info
+              let signal = make obj
+              let monitor =
+                let esc_prop = get_emits_changed_signal (OBus_member.Property.annotations P.info)
+                and esc_intf = get_emits_changed_signal obj.interfaces.(i).i_annotations in
+                let info = (module P : Property_info with type obj = d t and type typ = P.typ) in
+                match esc_prop, esc_intf with
+                  | Esc_false, _ | Esc_default, Esc_false ->
+                      E.never
+                  | Esc_true, _ | Esc_default, (Esc_default | Esc_true) ->
+                      E.map (handle_property_change_true obj i info) (S.changes signal)
+                  | Esc_invalidates, _ | Esc_default, Esc_invalidates ->
+                      E.map (handle_property_change_invalidates obj i info) (S.changes signal)
+            end in
+            instances.(j) <- (Some(module I : Property_instance))
+        | None ->
+            ()
+    done
+  done
+
+(* +-----------------------------------------------------------------+
+   | Member informations                                             |
+   +-----------------------------------------------------------------+ *)
+
+let method_info (type d) (type i) (type o) info f =
+  let module M = struct
+    type obj = d t
+    type i_type = i
+    type o_type = o
+    let info = info
+    let handler = f
+  end in
+  (module M : Method_info with type obj = d t)
+
+let signal_info (type d) (type i) info =
+  let module M = struct
+    type obj = d t
+    type typ = i
+    let info = info
+  end in
+  (module M : Signal_info with type obj = d t)
+
+let property_r_info (type d) (type i) (type a) info signal =
+  let module M = struct
+    type obj = d t
+    type typ = i
+    type access = a
+    let info = info
+    let set = None
+    let signal = Some signal
+  end in
+  (module M : Property_info with type obj = d t)
+
+let property_w_info (type d) (type i) (type a) info set =
+  let module M = struct
+    type obj = d t
+    type typ = i
+    type access = a
+    let info = info
+    let set = Some set
+    let signal = None
+  end in
+  (module M : Property_info with type obj = d t)
+
+let property_rw_info (type d) (type i) (type a) info signal set =
+  let module M = struct
+    type obj = d t
+    type typ = i
+    type access = a
+    let info = info
+    let set = Some set
+    let signal = Some signal
+  end in
+  (module M : Property_info with type obj = d t)
+
+(* +-----------------------------------------------------------------+
+   | Interfaces creation                                             |
+   +-----------------------------------------------------------------+ *)
+
+let make_interface_unsafe name annotations methods signals properties = {
+  i_name = name;
+  i_methods = methods;
+  i_signals = signals;
+  i_properties = properties;
+  i_annotations = annotations;
+}
+
+let compare_methods (type d) m1 m2 =
+  let module M1 = (val m1 : Method_info with type obj = d t) in
+  let module M2 = (val m2 : Method_info with type obj = d t) in
+  String.compare (OBus_member.Method.member M1.info) (OBus_member.Method.member M2.info)
+
+let compare_signals (type d) s1 s2 =
+  let module S1 = (val s1 : Signal_info with type obj = d t) in
+  let module S2 = (val s2 : Signal_info with type obj = d t) in
+  String.compare (OBus_member.Signal.member S1.info) (OBus_member.Signal.member S2.info)
+
+let compare_properties (type d) p1 p2 =
+  let module P1 = (val p1 : Property_info with type obj = d t) in
+  let module P2 = (val p2 : Property_info with type obj = d t) in
+  String.compare (OBus_member.Property.member P1.info) (OBus_member.Property.member P2.info)
+
+let make_interface ~name ?(annotations=[]) ?(methods=[]) ?(signals=[]) ?(properties=[]) () =
+  let methods = Array.of_list methods
+  and signals = Array.of_list signals
+  and properties = Array.of_list properties in
+  Array.sort compare_methods methods;
+  Array.sort compare_signals signals;
+  Array.sort compare_properties properties;
+  make_interface_unsafe name annotations methods signals properties
+
+let process_interfaces interfaces =
+  let rec uniq = function
+    | iface :: iface' :: rest when iface.i_name = iface'.i_name ->
+        uniq (iface :: rest)
+    | iface :: rest ->
+        iface :: uniq rest
+    | [] ->
+        []
+  and compare i1 i2 =
+    String.compare i1.i_name i2.i_name
+  in
+  Array.of_list (uniq (List.stable_sort compare interfaces))
+
+let add_interfaces obj interfaces =
+  obj.interfaces <- process_interfaces (interfaces @ Array.to_list obj.interfaces);
+  generate obj
+
+let remove_interfaces_by_names obj names =
+  obj.interfaces <- Array.of_list (List.filter (fun iface -> not (List.mem iface.i_name names)) (Array.to_list obj.interfaces));
+  generate obj
+
+let remove_interfaces obj interfaces =
+  remove_interfaces_by_names obj (List.map (fun iface -> iface.i_name) interfaces)
+
+(* +-----------------------------------------------------------------+
+   | Common interfaces                                               |
+   +-----------------------------------------------------------------+ *)
+
+open OBus_member
+
+let introspectable (type d) () =
+  let interface = "org.freedesktop.DBus.Introspectable" in
+  make_interface_unsafe interface []
+    [|
+      (let module M = struct
+         type obj = d t
+         type i_type = unit
+         type o_type = string
+
+         let info = {
+           Method.interface = interface;
+           Method.member = "Introspect";
+           Method.i_args = OBus_value.arg0;
+           Method.o_args = OBus_value.arg1 (Some "result", OBus_value.C.basic_string);
+           Method.annotations = [];
+         }
+
+         let handler obj () =
+           let context = OBus_context.get () in
+           let info = get_info (OBus_context.connection context) in
+           let buf = Buffer.create 42 in
+           OBus_introspect.output
+             (Xmlm.make_output ~nl:true ~indent:(Some 2) (`Buffer buf))
+             (introspect obj, children info obj.path);
+           Lwt.return (Buffer.contents buf)
+       end in
+       (module M : Method_info with type obj = d t));
+    |]
+    [||]
+    [||]
+
+let properties (type d) () =
+  let interface = "org.freedesktop.DBus.Properties" in
+  make_interface_unsafe interface []
+    [|
+      (let module M = struct
+         type obj = d t
+         type i_type = string * string
+         type o_type = OBus_value.V.single
+
+         let info = {
+           Method.interface = interface;
+           Method.member = "Get";
+           Method.i_args =
+             OBus_value.arg2
+               (Some "interface", OBus_value.C.basic_string)
+               (Some "member", OBus_value.C.basic_string);
+           Method.o_args =
+             OBus_value.arg1
+               (Some "value", OBus_value.C.variant);
+           Method.annotations = [];
+         }
+
+         let handler obj (interface, member) =
+           match binary_search compare_interface interface obj.interfaces with
+             | -1 ->
+                 Lwt.fail (OBus_error.Unknown_interface(Printf.sprintf "Interface %S does not exists" interface))
+             | i ->
+                 match binary_search compare_property member obj.interfaces.(i).i_properties with
+                   | -1 ->
+                       Lwt.fail (OBus_error.Unknown_property(Printf.sprintf "Property %S on interface %S does not exists" member interface))
+                   | j ->
+                       match obj.properties.(i).(j) with
+                         | Some instance ->
+                             let module I = (val instance : Property_instance) in
+                             Lwt.return (OBus_value.C.make_single (Property.typ I.info) (S.value I.signal))
+                         | None ->
+                             Lwt.fail (OBus_error.Failed(Printf.sprintf "Property %S on interface %S is not readable" member interface))
+       end in
+       (module M : Method_info with type obj = d t));
+
+      (let module M = struct
+         type obj = d t
+         type i_type = string
+         type o_type = (string * OBus_value.V.single) list
+
+         let info = {
+           Method.interface = interface;
+           Method.member = "GetAll";
+           Method.i_args =
+             OBus_value.arg1
+               (Some "interface", OBus_value.C.basic_string);
+           Method.o_args =
+             OBus_value.arg1
+               (Some "values", OBus_value.C.dict OBus_value.C.string OBus_value.C.variant);
+           Method.annotations = [];
+         }
+
+         let handler obj interface =
+           match binary_search compare_interface interface obj.interfaces with
+             | -1 ->
+                 Lwt.fail (OBus_error.Unknown_interface(Printf.sprintf "Interface %S does not exists" interface))
+             | i ->
+                 let count = Array.length obj.properties.(i) in
+                 let rec loop j acc =
+                   if j = count then
+                     acc
+                   else
+                     match obj.properties.(i).(j) with
+                       | Some instance ->
+                           let module I = (val instance : Property_instance) in
+                           loop (j + 1)
+                             ((Property.member I.info,
+                               OBus_value.C.make_single (Property.typ I.info) (S.value I.signal)) :: acc)
+                       | None ->
+                           loop (j + 1) acc
+                 in
+                 Lwt.return (loop 0 [])
+       end in
+       (module M : Method_info with type obj = d t));
+
+      (let module M = struct
+         type obj = d t
+         type i_type = string * string * OBus_value.V.single
+         type o_type = unit
+
+         let info = {
+           Method.interface = interface;
+           Method.member = "Set";
+           Method.i_args =
+             OBus_value.arg3
+               (Some "interface", OBus_value.C.basic_string)
+               (Some "member", OBus_value.C.basic_string)
+               (Some "value", OBus_value.C.variant);
+           Method.o_args =
+             OBus_value.arg0;
+           Method.annotations = [];
+         }
+
+         let handler obj (interface, member, value) =
+           match binary_search compare_interface interface obj.interfaces with
+             | -1 ->
+                 Lwt.fail (OBus_error.Unknown_interface(Printf.sprintf "Interface %S does not exists" interface))
+             | i ->
+                 match binary_search compare_property member obj.interfaces.(i).i_properties with
+                   | -1 ->
+                       Lwt.fail (OBus_error.Unknown_property(Printf.sprintf "Property %S on interface %S does not exists" member interface))
+                   | j ->
+                       let module P = (val obj.interfaces.(i).i_properties.(j) : Property_info with type obj = d t) in
+                       match P.set with
+                         | Some f -> begin
+                             match try `Success(OBus_value.C.cast_single (Property.typ P.info) value) with exn -> `Failure exn with
+                               | `Success value ->
+                                   f obj value
+                               | `Failure OBus_value.C.Signature_mismatch ->
+                                   Lwt.fail
+                                     (OBus_error.Failed
+                                        (Printf.sprintf
+                                           "invalid type(%S) for property %S on interface %S, should be %S"
+                                           (OBus_value.string_of_signature
+                                              [OBus_value.V.type_of_single value])
+                                           member
+                                           interface
+                                           (OBus_value.string_of_signature
+                                              [OBus_value.C.type_single
+                                                 (Property.typ P.info)])))
+                               | `Failure exn ->
+                                   Lwt.fail exn
+                           end
+                         | None ->
+                             Lwt.fail (OBus_error.Property_read_only(Printf.sprintf "property %S on interface %S is not writable" member interface))
+       end in
+       (module M : Method_info with type obj = d t));
+    |]
+    [|
+      (let module S = struct
+         type obj = d t
+         type typ = string * (string * OBus_value.V.single) list * string list
+         let info = {
+           Signal.interface = interface;
+           Signal.member = "PropertiesChanged";
+           Signal.args =
+             OBus_value.arg3
+               (Some "interface", OBus_value.C.basic_string)
+               (Some "updates", OBus_value.C.dict OBus_value.C.string OBus_value.C.variant)
+               (Some "invalidates", OBus_value.C.array OBus_value.C.basic_string);
+           Signal.annotations = [];
+         }
+       end in
+       (module S : Signal_info with type obj = d t));
+    |]
+    [||]
+
+(* +-----------------------------------------------------------------+
+   | Constructors                                                    |
+   +-----------------------------------------------------------------+ *)
+
+let properties_changed obj interface values =
+  emit obj
+    ~interface:"org.freedesktop.DBus.Properties"
+    ~member:"PropertiesChanged"
+    (OBus_value.C.seq3
+       OBus_value.C.basic_string
+       (OBus_value.C.dict OBus_value.C.string OBus_value.C.variant)
+       (OBus_value.C.array OBus_value.C.basic_string))
+    (interface,
+     OBus_util.filter_map
+       (function
+          | (name, Some value) -> Some(name, value)
+          | (name, None) -> None)
+       values,
+     OBus_util.filter_map
+       (function
+          | (name, Some value) -> None
+          | (name, None) -> Some name)
+       values)
+
+let make ?owner ?(common=true) ?(interfaces=[]) path =
+  let interfaces = if common then introspectable () :: properties () :: interfaces else interfaces in
+  let exports, set_exports = S.create ~eq:Connection_set.equal Connection_set.empty in
+  let obj = {
+    path = path;
+    exports = exports;
+    set_exports = set_exports;
+    owner = owner;
+    data = None;
+    properties = [||];
+    interfaces = process_interfaces interfaces;
+    changed = [||];
+    properties_changed = ref (fun name values -> assert false);
+  } in
+  obj.properties_changed := (fun name values -> properties_changed obj name values);
+  obj
+
+let attach obj data =
+  match obj.data with
+    | Some _ ->
+        failwith "OBus_object.attach: object already contains attached"
+    | None ->
+        obj.data <- Some data;
+        generate obj;
+        match obj.owner with
+          | None ->
+              ()
+          | Some peer ->
+              export (OBus_peer.connection peer) obj;
+              ignore (let%lwt () = OBus_peer.wait_for_exit peer in
+                      destroy obj;
+                      Lwt.return ())
+
+let get obj =
+  match obj.data with
+    | Some data -> data
+    | None -> failwith "OBus_object.get: no data attached"
diff --git a/src/protocol/oBus_object.mli b/src/protocol/oBus_object.mli
new file mode 100644
index 0000000..db55a70
--- /dev/null
+++ b/src/protocol/oBus_object.mli
@@ -0,0 +1,204 @@
+(*
+ * oBus_object.mli
+ * ---------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Local D-Bus objects *)
+
+(** This module allows you to create D-Bus objects and export them on a
+    connection, allowing other programs to acccess them. *)
+
+(** {6 Types} *)
+
+type 'a t
+  (** Type of local D-Bus objects. It contains informations needed by
+      obus to export it on a connection and dispatch incoming method
+      calls.
+
+      ['a] is the type of value that may be attached to this
+      object. *)
+
+type 'a interface
+  (** An interface description *)
+
+type 'a method_info
+  (** Informations about a method *)
+
+type 'a signal_info
+  (** Informations about a signal *)
+
+type 'a property_info
+  (** Informations about a property *)
+
+(** {6 Objects creation} *)
+
+val attach : 'a t -> 'a -> unit
+  (** [attach obus_object custom_obejct] attaches [custom_object] to
+      [obus_object]. [custom_object] will be the value received by
+      method call handlers. Note that you need to attach the object
+      before you can export it on a coneection and you can not attach
+      an object multiple times. *)
+
+val get : 'a t -> 'a
+  (** [get obj] returns the data attached to the given object *)
+
+val make : ?owner : OBus_peer.t -> ?common : bool -> ?interfaces : 'a interface list -> OBus_path.t -> 'a t
+  (** [make ?owner ?common ?interfaces path] creates a new D-Bus
+      object with path [path].
+
+      If [owner] is specified, then:
+      - all signals will be sent to it by default,
+      - the object will be removed from all its exports when the owner exits,
+      - it will automatically be exported on the connection of the owner when
+        [attach] is invoked.
+
+      [interfaces] is the list of interfaces implemented by the
+      object. New interfaces can be added latter with
+      {!add_interfaces}. If [common] is [true] (the default) then
+      {!introspectable} and {!properties} are automatically added. *)
+
+(** {6 Properties} *)
+
+val path : 'a t -> OBus_path.t
+  (** [path obj] returns the path of the object *)
+
+val owner : 'a t -> OBus_peer.t option
+  (** [owner obj] returns the owner of the object, if any *)
+
+val exports : 'a t -> Set.Make(OBus_connection).t React.signal
+  (** [exports obj] is a signal holding the list of connnections on
+      which the object is exported. *)
+
+val introspect : 'a t -> OBus_introspect.interface list
+  (** [introspect obj] returns the introspection of all interfaces
+      implemented by [obj] *)
+
+val on_properties_changed : 'a t -> (OBus_name.interface -> (OBus_name.member * OBus_value.V.single option) list -> unit Lwt.t) ref
+  (** Function called when one or more properties of the given object
+      change. The new contents of the property is given along with the
+      property name according to the
+      [org.freedesktop.DBus.Property.EmitsChangedSignal].
+
+      The default function uses the standard
+      [org.freedesktop.DBus.Properties.PropertiesChanged] signal. *)
+
+(** {6 Exports} *)
+
+val export : OBus_connection.t -> 'a t -> unit
+  (** [export connection obj] exports [obj] on [connection]. It raises
+      {!OBus_connection.Connection_closed} if the connection is closed. *)
+
+val remove : OBus_connection.t -> 'a t -> unit
+  (** [remove connection obj] removes [obj] from [connection]. It does
+      nothing if the connection is closed. *)
+
+val remove_by_path : OBus_connection.t -> OBus_path.t -> unit
+  (** [remove_by_path connection path] removes the object with path
+      [path] on [connection]. It works for normal objects and dynamic
+      nodes. It does nothing if the connection is closed. *)
+
+val destroy : 'a t -> unit
+  (** [destroy obj] removes [obj] from all connection it is exported
+      on *)
+
+val dynamic :
+  connection : OBus_connection.t ->
+  prefix : OBus_path.t ->
+  handler : (OBus_context.t -> OBus_path.t -> 'a t Lwt.t) -> unit
+  (** [dynamic ~connection ~prefix ~handler] defines a dynamic node in
+      the tree of object. This means that objects with a path prefixed
+      by [prefix], will be created on the fly by [handler] when a
+      process try to access them.
+
+      [handler] receive the context and rest of path after the
+      prefix. It may raises [Not_found] to indicates that there is no
+      object under the given path.
+
+      Note: if you manually export an object with a path prefixed by
+      [prefix], it will have precedence over the one created by
+      [handler]. *)
+
+(** {6 Interfaces} *)
+
+val make_interface : name : OBus_name.interface ->
+  ?annotations : OBus_introspect.annotation list ->
+  ?methods : 'a method_info list ->
+  ?signals : 'a signal_info list ->
+  ?properties : 'a property_info list -> unit -> 'a interface
+  (** [make_interface ~name ?annotations ?methods ?signals ?properties ()]
+      creates a new interface *)
+
+(**/**)
+
+val make_interface_unsafe : OBus_name.interface ->
+  OBus_introspect.annotation list ->
+  'a method_info array ->
+  'a signal_info array ->
+  'a property_info array -> 'a interface
+
+(**/**)
+
+val add_interfaces : 'a t -> 'a interface list -> unit
+  (** [add_interfaces obj ifaces] adds suport for the interfaces
+      described by [ifaces] to the given object. If an interface with
+      the same name is already attached to the object, then it is
+      replaced by the new one. *)
+
+val remove_interfaces : 'a t -> 'a interface list -> unit
+  (** [remove_interaces obj ifaces] removes informations about the
+      given interfaces from [obj]. If [obj] does not implement some of
+      the interfaces, it does nothing. *)
+
+val remove_interfaces_by_names : 'a t -> OBus_name.interface list -> unit
+  (** Same as {!remove_interfaces} but takes only the interface names
+      as argument. *)
+
+(** {8 Well-known interfaces} *)
+
+val introspectable : unit -> 'a interface
+  (** The [org.freedesktop.DBus.Introspectable] interface *)
+
+val properties : unit -> 'a interface
+  (** The [org.freedesktop.DBus.Properties] interface *)
+
+(** {6 Members} *)
+
+val method_info : ('a, 'b) OBus_member.Method.t -> ('c t -> 'a -> 'b Lwt.t) -> 'c method_info
+  (** [method_info desc handler] creates a method-call
+      member. [handler] receive the destination object of the method
+      call and the arguments of the method call. The context of the
+      call is also available to [handler] by using
+      {!OBus_context.get}. *)
+
+val signal_info : 'a OBus_member.Signal.t -> 'b signal_info
+  (** Defines a signal. It is only used for introspection *)
+
+val property_r_info : ('a, [ `readable ]) OBus_member.Property.t -> ('b t -> 'a React.signal) -> 'b property_info
+  (** [property_r_info desc get] defines a read-only property. [get]
+      is called once when data is attached to an object with
+      {!attach}. It must return a signal holding the current value of
+      the property. *)
+
+val property_w_info : ('a, [ `writable ]) OBus_member.Property.t -> ('b t -> 'a -> unit Lwt.t) -> 'b property_info
+  (** [property_w_info desc set] defines a write-only property. [set]
+      is used to set the propertry contents. *)
+
+val property_rw_info : ('a, [ `readable | `writable ]) OBus_member.Property.t -> ('b t -> 'a React.signal) -> ('b t -> 'a -> unit Lwt.t) -> 'b property_info
+  (** [property_rw_info desc get set] defines a readable and writable
+      property. [get] and [set] have the same semantic as for
+      {!property_r_info} and {!property_w_info}. *)
+
+(** {6 Signals} *)
+
+val emit : 'a t ->
+  interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  ?peer : OBus_peer.t ->
+  'b OBus_value.C.sequence -> 'b -> unit Lwt.t
+  (** [emit obj ~interface ~member ?peer typ args] emits a signal. it
+      uses the same rules as {!OBus_signal.emit} for choosing the
+      destinations of the signal.  *)
diff --git a/src/protocol/oBus_peer.ml b/src/protocol/oBus_peer.ml
new file mode 100644
index 0000000..bdb1fc8
--- /dev/null
+++ b/src/protocol/oBus_peer.ml
@@ -0,0 +1,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
diff --git a/src/protocol/oBus_peer.mli b/src/protocol/oBus_peer.mli
new file mode 100644
index 0000000..03524ff
--- /dev/null
+++ b/src/protocol/oBus_peer.mli
@@ -0,0 +1,107 @@
+(*
+ * oBus_peer.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus peers *)
+
+(** A D-Bus peer represent an application which can be reach though a
+    D-Bus connection. It is the application at the end-point of the
+    connection or, if the end-point is a message bus, any application
+    connected to it. *)
+
+type t = {
+  connection : OBus_connection.t;
+  (** Connection used to reach the peer. *)
+
+  name : OBus_name.bus;
+  (** Name of the peer. This only make sense if the connection is a
+      connection to a message bus. *)
+}
+
+val compare : t -> t -> int
+  (** Same as [Pervasives.compare]. It allows this module to be used
+      as argument to the functors [Set.Make] and [Map.Make]. *)
+
+val connection : t -> OBus_connection.t
+  (** [connection] projection *)
+
+val name : t -> OBus_name.bus
+  (** [name] projection *)
+
+(** Note that it is possible to use either a unique connection name or
+    a bus name as peer name.
+
+    Both possibility have advantages and drawbacks:
+
+    - using bus names such as "org.freedesktop.DBus.Hal" avoid the
+    need to resolve the name. When doing the first method call the bus
+    will automatically start the service if available. Also if the
+    service restarts the peer will still be valid.
+
+    One drawback is that the owner may change over the time, and
+    method calls may not be made on the same peer.
+
+    - using a unique name, which can be retreived with bus functions
+    (see {!OBus_bus}), ensures that the peer won't change over time.
+    By the way if the service exits, or another application replaces it
+    and we want to always use the default one, we have to write the
+    code to handle owner change.
+
+    So, one good strategy is to use bus names when calls do not involve
+    side-effect on the service such as object creation, and use unique
+    names for object created on our demand. Basically you can stick to
+    this rule:
+
+    Always use bus name for a well-known objects, such as
+    "/org/freedesktop/Hal/Manager" on "org.freedesktop.Hal.Manager"
+    and use unique name for objects for which the path is retrieved
+    from a method call.
+*)
+
+val make : connection : OBus_connection.t -> name : OBus_name.bus -> t
+  (** [make connection name] make a named peer *)
+
+val anonymous : OBus_connection.t -> t
+  (** [anonymous connection] make an anonymous peer *)
+
+val ping : t -> t Lwt.t
+  (** Ping a peer, and return the peer which really respond to the
+      ping.
+
+      For example, the fastest way to get the the peer owning a bus
+      name, and start it if not running is:
+
+      [ping (OBus_peer.make bus "well.known.name")] *)
+
+val get_machine_id : t -> OBus_uuid.t Lwt.t
+  (** @return the id of the machine the peer is running on *)
+
+val wait_for_exit : t -> unit Lwt.t
+  (** [wait_for_exit peer] wait until [peer] exit. If [peer] is not
+      running then it returns immediatly. Raises [Invalid_argument] if
+      the peer has no name. *)
+
+(** {6 Private peers} *)
+
+type peer = t
+
+(** Minimal interface of private peers *)
+module type Private = sig
+  type t = private peer
+
+  external of_peer : peer -> t = "%identity"
+  external to_peer : t -> peer = "%identity"
+end
+
+(** Minimal implementation of private peers *)
+module Private : sig
+  type t = peer
+
+  external of_peer : peer -> t = "%identity"
+  external to_peer : t -> peer = "%identity"
+end
diff --git a/src/protocol/oBus_property.ml b/src/protocol/oBus_property.ml
new file mode 100644
index 0000000..78baaf1
--- /dev/null
+++ b/src/protocol/oBus_property.ml
@@ -0,0 +1,364 @@
+(*
+ * oBus_property.ml
+ * ----------------
+ * Copyright : (c) 2010, 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(property)"
+
+open Lwt.Infix
+open Lwt_react
+open OBus_interfaces.Org_freedesktop_DBus_Properties
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+module String_map = Map.Make(String)
+
+type map = (OBus_context.t * OBus_value.V.single) String_map.t
+
+type monitor = OBus_proxy.t -> OBus_name.interface -> Lwt_switch.t -> map signal Lwt.t
+
+type ('a, 'access) t = {
+  p_interface : OBus_name.interface;
+  (* The interface of the property. *)
+
+  p_member : OBus_name.member;
+  (* The name of the property. *)
+
+  p_proxy : OBus_proxy.t;
+  (* The object owning the property. *)
+
+  p_monitor : monitor;
+  (* Monitor for this property. *)
+
+  p_cast : OBus_context.t -> OBus_value.V.single -> 'a;
+  p_make : 'a -> OBus_value.V.single;
+}
+
+type 'a r = ('a, [ `readable ]) t
+type 'a w = ('a, [ `writable ]) t
+type 'a rw = ('a, [ `readable | `writable ]) t
+
+type group = {
+  g_interface : OBus_name.interface;
+  (* The interface of the group *)
+
+  g_proxy : OBus_proxy.t;
+  (* The object owning the group of properties *)
+
+  g_monitor : monitor;
+  (* Monitor for this group. *)
+}
+
+module Group_map = Map.Make
+  (struct
+     type t = OBus_name.bus * OBus_path.t * OBus_name.interface
+         (* Groups are indexed by:
+            - name of the owner of the property
+            - path of the object owning the property
+            - interfaec of the property *)
+     let compare = Pervasives.compare
+   end)
+
+(* Type of a cache for a group *)
+type cache = {
+  mutable c_count : int;
+  (* Numbers of monitored properties using this group. *)
+
+  c_map : map signal;
+  (* The signal holding the current state of properties. *)
+
+  c_switch : Lwt_switch.t;
+  (* Switch for the signal used to monitor the group. *)
+}
+
+type info = {
+  mutable cache : cache Lwt.t Group_map.t;
+  (* Cache of all monitored properties. *)
+}
+
+(* +-----------------------------------------------------------------+
+   | Default monitor                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let update_map context dict map =
+  List.fold_left (fun map (name, value) -> String_map.add name (context, value) map) map dict
+
+let map_of_list context dict =
+  update_map context dict String_map.empty
+
+let get_all_no_cache proxy interface =
+  OBus_method.call_with_context m_GetAll proxy interface
+
+let default_monitor proxy interface switch =
+  let%lwt event =
+    OBus_signal.connect ~switch
+      (OBus_signal.with_filters
+         (OBus_match.make_arguments [(0, OBus_match.AF_string interface)])
+         (OBus_signal.with_context
+            (OBus_signal.make s_PropertiesChanged proxy)))
+  and context, dict = get_all_no_cache proxy interface in
+  Lwt.return (S.map snd
+                (S.fold_s ~eq:(fun (_, a) (_, b) -> String_map.equal (=) a b)
+                   (fun (_, map) (sig_context, (interface, updates, invalidates)) ->
+                      if invalidates = [] then
+                        Lwt.return (sig_context, update_map sig_context updates map)
+                      else
+                        let%lwt context, dict = get_all_no_cache proxy interface in
+                        Lwt.return (sig_context, map_of_list context dict))
+                   (context, map_of_list context dict)
+                   event))
+
+(* +-----------------------------------------------------------------+
+   | Property creation                                               |
+   +-----------------------------------------------------------------+ *)
+
+let make ?(monitor=default_monitor) desc proxy = {
+  p_interface = OBus_member.Property.interface desc;
+  p_member = OBus_member.Property.member desc;
+  p_proxy = proxy;
+  p_monitor = monitor;
+  p_cast = (fun context value -> OBus_value.C.cast_single (OBus_member.Property.typ desc) value);
+  p_make = (OBus_value.C.make_single (OBus_member.Property.typ desc));
+}
+
+let group ?(monitor=default_monitor) proxy interface = {
+  g_proxy = proxy;
+  g_interface = interface;
+  g_monitor = monitor;
+}
+
+(* +-----------------------------------------------------------------+
+   | Transformations                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let map_rw f g property = {
+  property with
+    p_cast = (fun context x -> f (property.p_cast context x));
+    p_make = (fun x -> property.p_make (g x));
+}
+
+let map_rw_with_context f g property = {
+  property with
+    p_cast = (fun context x -> f context (property.p_cast context x));
+    p_make = (fun x -> property.p_make (g x));
+}
+
+let map_r f property = {
+  property with
+    p_cast = (fun context x -> f (property.p_cast context x));
+    p_make = (fun x -> assert false);
+}
+
+let map_r_with_context f property = {
+  property with
+    p_cast = (fun context x -> f context (property.p_cast context x));
+    p_make = (fun x -> assert false);
+}
+
+let map_w g property = {
+  property with
+    p_cast = (fun context x -> assert false);
+    p_make = (fun x -> property.p_make (g x));
+}
+
+(* +-----------------------------------------------------------------+
+   | Operations on maps                                              |
+   +-----------------------------------------------------------------+ *)
+
+let find property map =
+  let context, value = String_map.find property.p_member map in
+  property.p_cast context value
+
+let find_with_context property map =
+  let context, value = String_map.find property.p_member map in
+  (context, property.p_cast context value)
+
+let find_value name map =
+  let context, value = String_map.find name map in
+  value
+
+let find_value_with_context name map =
+  String_map.find name map
+
+let print_map pp map =
+  let open Format in
+  pp_open_box pp 2;
+  pp_print_string pp "{";
+  pp_print_cut pp ();
+  pp_open_hvbox pp 0;
+  String_map.iter
+    (fun name (context, value) ->
+       pp_open_box pp 0;
+       pp_print_string pp name;
+       pp_print_space pp ();
+       pp_print_string pp "=";
+       pp_print_space pp ();
+       OBus_value.V.print_single pp value;
+       pp_print_string pp ";";
+       pp_close_box pp ();
+       pp_print_cut pp ())
+    map;
+  pp_close_box pp ();
+  pp_print_cut pp ();
+  pp_print_string pp "}";
+  pp_close_box pp ()
+
+let string_of_map map =
+  let open Format in
+  let buf = Buffer.create 42 in
+  let pp = formatter_of_buffer buf in
+  pp_set_margin pp max_int;
+  print_map pp map;
+  pp_print_flush pp ();
+  Buffer.contents buf
+
+(* +-----------------------------------------------------------------+
+   | Properties reading/writing                                      |
+   +-----------------------------------------------------------------+ *)
+
+let key = OBus_connection.new_key ()
+
+let get_with_context prop =
+  match OBus_connection.get (OBus_proxy.connection prop.p_proxy) key with
+    | Some info -> begin
+        match
+          try
+            Some(Group_map.find (OBus_proxy.name prop.p_proxy,
+                                 OBus_proxy.path prop.p_proxy,
+                                 prop.p_interface) info.cache)
+          with Not_found ->
+            None
+        with
+          | Some cache_thread ->
+              let%lwt cache = cache_thread in
+              Lwt.return (find_with_context prop (S.value cache.c_map))
+          | None ->
+              let%lwt context, value = OBus_method.call_with_context m_Get prop.p_proxy (prop.p_interface, prop.p_member) in
+              Lwt.return (context, prop.p_cast context value)
+      end
+    | None ->
+        let%lwt context, value = OBus_method.call_with_context m_Get prop.p_proxy (prop.p_interface, prop.p_member) in
+        Lwt.return (context, prop.p_cast context value)
+
+let get prop =
+  get_with_context prop >|= snd
+
+let set prop value =
+  OBus_method.call m_Set prop.p_proxy (prop.p_interface, prop.p_member, prop.p_make value)
+
+let get_group group =
+  match OBus_connection.get (OBus_proxy.connection group.g_proxy) key with
+    | Some info -> begin
+        match
+          try
+            Some(Group_map.find (OBus_proxy.name group.g_proxy,
+                                 OBus_proxy.path group.g_proxy,
+                                 group.g_interface) info.cache)
+          with Not_found ->
+            None
+        with
+          | Some cache_thread ->
+              let%lwt cache = cache_thread in
+              Lwt.return (S.value cache.c_map)
+          | None ->
+              let%lwt context, dict = get_all_no_cache group.g_proxy group.g_interface in
+              Lwt.return (map_of_list context dict)
+      end
+    | None ->
+        let%lwt context, dict = get_all_no_cache group.g_proxy group.g_interface in
+        Lwt.return (map_of_list context dict)
+
+(* +-----------------------------------------------------------------+
+   | Monitoring                                                      |
+   +-----------------------------------------------------------------+ *)
+
+let finalise disable _ =
+  ignore (Lazy.force disable)
+
+let monitor_group ?switch group =
+  Lwt_switch.check switch;
+  let cache_key = (OBus_proxy.name group.g_proxy, OBus_proxy.path group.g_proxy, group.g_interface) in
+  let info =
+    match OBus_connection.get (OBus_proxy.connection group.g_proxy) key with
+      | Some info ->
+          info
+      | None ->
+          let info = { cache = Group_map.empty } in
+          OBus_connection.set (OBus_proxy.connection group.g_proxy) key (Some info);
+          info
+  in
+  let%lwt cache =
+    match
+      try
+        Some(Group_map.find cache_key info.cache)
+      with Not_found ->
+        None
+    with
+      | Some cache_thread ->
+          cache_thread
+      | None ->
+          let waiter, wakener = Lwt.wait () in
+          info.cache <- Group_map.add cache_key waiter info.cache;
+          let switch = Lwt_switch.create () in
+          try%lwt
+            let%lwt signal = group.g_monitor group.g_proxy group.g_interface switch in
+            let cache = {
+              c_count = 0;
+              c_map = signal;
+              c_switch = switch;
+            } in
+            Lwt.wakeup wakener cache;
+            Lwt.return cache
+          with exn ->
+            info.cache <- Group_map.remove cache_key info.cache;
+            Lwt.wakeup_exn wakener exn;
+            let%lwt () = Lwt_switch.turn_off switch in
+            Lwt.fail exn
+  in
+
+  cache.c_count <- cache.c_count + 1;
+
+  let disable = lazy(
+    try%lwt
+      cache.c_count <- cache.c_count - 1;
+      if cache.c_count = 0 then begin
+        info.cache <- Group_map.remove cache_key info.cache;
+        Lwt_switch.turn_off cache.c_switch
+      end else
+        Lwt.return ()
+    with exn ->
+      let%lwt () =
+        Lwt_log.warning_f
+          ~section
+          ~exn
+          "failed to disable monitoring of properties for interface %S on object %S from %S"
+          group.g_interface
+          (OBus_path.to_string (OBus_proxy.path group.g_proxy))
+          (OBus_proxy.name group.g_proxy)
+      in
+      Lwt.fail exn
+  ) in
+
+  let signal = S.with_finaliser (finalise disable) cache.c_map in
+
+  let%lwt () =
+    Lwt_switch.add_hook_or_exec
+      switch
+      (fun () ->
+         S.stop signal;
+         Lazy.force disable)
+  in
+
+  Lwt.return signal
+
+let monitor ?switch prop =
+  let%lwt signal = monitor_group ?switch { g_interface = prop.p_interface;
+                                       g_proxy = prop.p_proxy;
+                                       g_monitor = prop.p_monitor } in
+  Lwt.return (S.map (find prop) signal)
diff --git a/src/protocol/oBus_property.mli b/src/protocol/oBus_property.mli
new file mode 100644
index 0000000..b6b905a
--- /dev/null
+++ b/src/protocol/oBus_property.mli
@@ -0,0 +1,145 @@
+(*
+ * oBus_property.mli
+ * -----------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus properties *)
+
+(** {6 Types} *)
+
+type ('a, 'access) t
+  (** Type of a property holding a value of type ['a]. ['access] is
+      the access mode of the property. *)
+
+type 'a r = ('a, [ `readable ]) t
+    (** Type of read-only properties *)
+
+type 'a w = ('a, [ `writable ]) t
+    (** Type of write-only properties *)
+
+type 'a rw = ('a, [ `readable | `writable ]) t
+    (** Type of read and write properties *)
+
+type map = (OBus_context.t * OBus_value.V.single) Map.Make(String).t
+  (** Type of all properties of an interface. *)
+
+type group
+  (** Type of a group of properties. Property groups are used to
+      read/monitor all the properties of an interface. *)
+
+type monitor = OBus_proxy.t -> OBus_name.interface -> Lwt_switch.t -> map React.signal Lwt.t
+  (** Type of a function creating a signal holding the contents of all
+      the properties of an interface. The default monitor uses the
+      [org.freedesktop.DBus.Properties.PropertiesChanged] signal. *)
+
+(** {6 Properties creation} *)
+
+val make : ?monitor : monitor -> ('a, 'access) OBus_member.Property.t -> OBus_proxy.t -> ('a, 'access) t
+  (** [make ?monitor property proxy] returns the property object for
+      this proxy. *)
+
+val group : ?monitor : monitor -> OBus_proxy.t -> OBus_name.interface -> group
+  (** [group ?monitor proxy interface] creates a group for all
+      readable properties of the given interface. Note that it is
+      faster to read a group of properties rather than reading each
+      property individually. *)
+
+(** {6 Properties transformation} *)
+
+val map_rw : ('a -> 'b) -> ('b -> 'a) -> 'a rw -> 'b rw
+  (** [map property f g] maps [property] with [f] and [g] *)
+
+val map_rw_with_context : (OBus_context.t -> 'a -> 'b) -> ('b -> 'a) -> 'a rw -> 'b rw
+  (** Same as {!map} except that the context is also passed to mapping
+      functions. *)
+
+val map_r : ('a -> 'b) -> ('a, [> `readable ]) t -> 'b r
+  (** Maps a read-only property. *)
+
+val map_r_with_context :  (OBus_context.t -> 'a -> 'b) -> ('a, [> `readable ]) t -> 'b r
+  (** Maps a read-only property, passing the context to the mapping
+      function *)
+
+val map_w : ('b -> 'a) -> ('a, [> `writable ]) t -> 'b w
+  (** Maps a write-only property. *)
+
+(** {6 Operations on properties} *)
+
+val get : ('a, [> `readable ]) t -> 'a Lwt.t
+  (** Read the contents of a property. *)
+
+val get_with_context : ('a, [> `readable ]) t -> (OBus_context.t * 'a) Lwt.t
+  (** Same as {!get} but also returns the context *)
+
+val set : ('a, [> `writable ]) t -> 'a -> unit Lwt.t
+  (** Write the contents of a property *)
+
+val get_group : group -> map Lwt.t
+  (** Returns the set of all properties that belong to the given
+      group. *)
+
+(** {6 Operations on property maps} *)
+
+val find_value : OBus_name.member -> map -> OBus_value.V.single
+  (** [find_value name map] returns the value associated to [name] in
+      [set]. It raises [Not_found] if [name] is not in [map]. *)
+
+val find_value_with_context : OBus_name.member -> map -> OBus_context.t * OBus_value.V.single
+  (** Same as {!find_value} but also returns the context in which the
+      property was received. *)
+
+val find : ('a, [> `readable ]) t -> map -> 'a
+  (** [find property map] looks up for the given property in [set] and
+      maps it to a value of type ['a]. It raises [Not_found] if
+      [property] does not belong to [map]. *)
+
+val find_with_context : ('a, [> `readable ]) t -> map -> OBus_context.t * 'a
+  (** Same as {!find} but also returns the context in which the
+      property was received. *)
+
+val print_map : Format.formatter -> map -> unit
+  (** [print_set pp map] prints all the properties of [map]. *)
+
+val string_of_map : map -> string
+  (** [string_of_set set] prints [set] into a string and returns it. *)
+
+(** {6 Monitoring} *)
+
+(** Lots of D-Bus services notify other applications with a D-Bus
+    signal when one or more properties of an object change. In this
+    case it is possible to monitor the contents of a property.
+
+    Note that when at least one property of an interface is monitored,
+    obus will keep a local state of all the properties of the
+    interface.
+*)
+
+val monitor : ?switch : Lwt_switch.t -> ('a, [> `readable ]) t -> 'a React.signal Lwt.t
+  (** [monitor ?switch property] returns the signal holding the
+      current contents of [property]. Raises [Failure] if the property
+      is not monitorable.
+
+      Resources allocated to monitor the property are automatically
+      freed when the signal is garbage collected *)
+
+val monitor_group : ?switch : Lwt_switch.t -> group -> map React.signal Lwt.t
+  (** [monitor_group ?switch group] monitors all properties of the
+      given group. *)
+
+(** {6 Helpers for custom monitors} *)
+
+val get_all_no_cache : OBus_proxy.t -> OBus_name.interface -> (OBus_context.t * (OBus_name.member * OBus_value.V.single) list) Lwt.t
+  (** [get_all_no_cache proxy interface] reads the value of all
+      properties without using the cache. *)
+
+val update_map : OBus_context.t -> (OBus_name.member * OBus_value.V.single) list -> map -> map
+  (** [update_map context values map] add all properties with their
+      context and value to [map]. *)
+
+val map_of_list : OBus_context.t -> (OBus_name.member * OBus_value.V.single) list -> map
+  (** [map_of_list context values] returns the map corresponding to
+      the given values and context. *)
diff --git a/src/protocol/oBus_proxy.ml b/src/protocol/oBus_proxy.ml
new file mode 100644
index 0000000..d4d186b
--- /dev/null
+++ b/src/protocol/oBus_proxy.ml
@@ -0,0 +1,97 @@
+(*
+ * oBus_proxy.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(proxy)"
+
+open OBus_peer
+open OBus_message
+
+type t = {
+  peer : OBus_peer.t;
+  path : OBus_path.t;
+}
+
+let compare = Pervasives.compare
+
+let make ~peer ~path = { peer = peer; path = path }
+
+let peer proxy = proxy.peer
+let path proxy = proxy.path
+let connection proxy = proxy.peer.connection
+let name proxy = proxy.peer.name
+
+type proxy = t
+
+module type Private = sig
+  type t = private proxy
+  external of_proxy : proxy -> t = "%identity"
+  external to_proxy : t -> proxy = "%identity"
+end
+
+module Private =
+struct
+  type t = proxy
+  external of_proxy : proxy -> t = "%identity"
+  external to_proxy : t -> proxy = "%identity"
+end
+
+(* +-----------------------------------------------------------------+
+   | Method calls                                                    |
+   +-----------------------------------------------------------------+ *)
+
+let call proxy ~interface ~member ~i_args ~o_args args =
+  OBus_connection.method_call
+    ~connection:proxy.peer.connection
+    ~destination:proxy.peer.name
+    ~path:proxy.path
+    ~interface
+    ~member
+    ~i_args
+    ~o_args
+    args
+
+let call_with_context proxy ~interface ~member ~i_args ~o_args args =
+  let%lwt msg, result =
+    OBus_connection.method_call_with_message
+      ~connection:proxy.peer.connection
+      ~destination:proxy.peer.name
+      ~path:proxy.path
+      ~interface
+      ~member
+      ~i_args
+      ~o_args
+      args
+  in
+  Lwt.return (OBus_context.make proxy.peer.connection msg, result)
+
+let call_no_reply proxy ~interface ~member ~i_args args =
+  OBus_connection.method_call_no_reply
+    ~connection:proxy.peer.connection
+    ~destination:proxy.peer.name
+    ~path:proxy.path
+    ~interface
+    ~member
+    ~i_args
+    args
+
+(* +-----------------------------------------------------------------+
+   | Introspection                                                   |
+   +-----------------------------------------------------------------+ *)
+
+let introspect proxy =
+  let%lwt str =
+    call proxy ~interface:"org.freedesktop.DBus.Introspectable" ~member:"Introspect"
+      ~i_args:OBus_value.C.seq0
+      ~o_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
+      ()
+  in
+  try
+    Lwt.return (OBus_introspect.input (Xmlm.make_input ~strip:true (`String(0, str))))
+  with Xmlm.Error((line, column), err) ->
+    Lwt.fail (Failure(Printf.sprintf "OBus_proxy.introspect: invalid document, at line %d: %s" line (Xmlm.error_message err)))
diff --git a/src/protocol/oBus_proxy.mli b/src/protocol/oBus_proxy.mli
new file mode 100644
index 0000000..e8aafdc
--- /dev/null
+++ b/src/protocol/oBus_proxy.mli
@@ -0,0 +1,93 @@
+(*
+ * oBus_proxy.mli
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Remote D-Bus objects *)
+
+(** A proxy is an object on which live on a different processus, but
+    behave as a native ocaml value. *)
+
+(** The default type for proxies *)
+type t = {
+  peer : OBus_peer.t;
+  (** Peer owning the object *)
+
+  path : OBus_path.t;
+  (** Path of the object on the peer *)
+}
+
+val compare : t -> t -> int
+  (** Same as [Pervasives.compare]. It allows this module to be used
+      as argument to the functors [Set.Make] and [Map.Make]. *)
+
+val make : peer : OBus_peer.t -> path : OBus_path.t -> t
+  (** Creates a proxy from the given peer and path *)
+
+(** {6 Informations} *)
+
+val peer : t -> OBus_peer.t
+  (** Returns the peer pointed by a proxy *)
+
+val path : t -> OBus_path.t
+  (** Returns the path of a proxy *)
+
+val connection : t -> OBus_connection.t
+  (** [connection proxy = OBus_peer.connection (peer proxy)] *)
+
+val name : t -> OBus_name.bus
+  (** [connection proxy = OBus_peer.name (peer proxy)] *)
+
+val introspect : t -> OBus_introspect.document Lwt.t
+  (** [introspect proxy] introspects the given proxy *)
+
+(** {6 Method calls} *)
+
+val call : t ->
+  interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence ->
+  o_args : 'b OBus_value.C.sequence -> 'a -> 'b Lwt.t
+  (** [call proxy ~interface ~member ~i_args ~o_args args] calls the
+      given method on the given proxy and wait for the reply. *)
+
+val call_with_context : t ->
+  interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence ->
+  o_args : 'b OBus_value.C.sequence -> 'a -> (OBus_context.t * 'b) Lwt.t
+  (** [call_with_context] is like {!call} except that is also returns
+      the context of the method return *)
+
+val call_no_reply : t ->
+  interface : OBus_name.interface ->
+  member : OBus_name.member ->
+  i_args : 'a OBus_value.C.sequence -> 'a -> unit Lwt.t
+  (** [call_no_reply] is the same as {!call} except that it does not
+      wait for a reply *)
+
+(** {6 Private proxies} *)
+
+(** The two following module interface and implementations are helpers
+    for using private proxies. A private proxy is just a normal proxy
+    but defined as a private type, to avoid incorrect use. *)
+
+type proxy = t
+
+(** Minimal interface of private proxies *)
+module type Private = sig
+  type t = private proxy
+  external of_proxy : proxy -> t = "%identity"
+  external to_proxy : t -> proxy = "%identity"
+end
+
+(** Minimal implementation of private proxies *)
+module Private : sig
+  type t = proxy
+  external of_proxy : proxy -> t = "%identity"
+  external to_proxy : t -> proxy = "%identity"
+end
diff --git a/src/protocol/oBus_resolver.ml b/src/protocol/oBus_resolver.ml
new file mode 100644
index 0000000..f892d14
--- /dev/null
+++ b/src/protocol/oBus_resolver.ml
@@ -0,0 +1,194 @@
+(*
+ * oBus_resolver.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(resolver)"
+
+open Lwt_react
+
+module String_map = Map.Make(String)
+
+(* We keep track on each connection of the last [cache_size] peers
+   that have already exited: *)
+let cache_size  = 100
+
+type resolver = {
+  mutable count : int;
+  (* Number of instances of this resolver. The resolver is
+     automatically disabled when this number reach 0. *)
+
+  owner : OBus_name.bus signal;
+  (* The owner of the name that is being monitored. *)
+
+  set_owner : OBus_name.bus -> unit;
+  (* Sets the owner. *)
+}
+
+(* Informations stored in connections *)
+and info = {
+  mutable resolvers : (resolver * Lwt_switch.t) Lwt.t String_map.t;
+  (* Mapping from names to active resolvers. The maps hold thread
+     instead of resolver directly to avoid the following problem:
+
+     1 - a resolver for a certain name is being created,
+     2 - the creation yields,
+     3 - another resolver for the same name is requested before the
+         creation of the previous one terminates,
+     4 - the second to register in this map wwill erase the first one.
+  *)
+
+  mutable exited : OBus_name.bus array;
+  (* Array holding the last [cache_size] peers that have already
+     exited *)
+
+  mutable exited_index : int;
+  (* Position where to store the next exited peers in [exited]. *)
+}
+
+let finalise remove _ =
+  ignore (Lazy.force remove)
+
+let has_exited peer_name info =
+  let rec loop index =
+    if index = cache_size then
+      false
+    else if info.exited.(index) = peer_name then
+      true
+    else
+      loop (index + 1)
+  in
+  loop 0
+
+let key = OBus_connection.new_key ()
+
+let get_name_owner connection name =
+  try%lwt
+    OBus_connection.method_call
+      ~connection
+      ~destination:OBus_protocol.bus_name
+      ~path:OBus_protocol.bus_path
+      ~interface:OBus_protocol.bus_interface
+      ~member:"GetNameOwner"
+      ~i_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
+      ~o_args:(OBus_value.C.seq1 OBus_value.C.basic_string)
+      name
+  with exn when OBus_error.name exn = "org.freedesktop.DBus.Error.NameHasNoOwner" ->
+    Lwt.return ""
+
+(* Handle NameOwnerChanged events *)
+let update_mapping info message =
+  let open OBus_message in
+  let open OBus_value in
+  match message with
+    | { sender = "org.freedesktop.DBus";
+        typ = Signal(["org"; "freedesktop"; "DBus"], "org.freedesktop.DBus", "NameOwnerChanged");
+        body = [V.Basic(V.String name); V.Basic(V.String old_owner); V.Basic(V.String new_owner)] } ->
+
+        if OBus_name.is_unique name && new_owner = "" && not (has_exited name info) then begin
+          (* Remember that the peer has exited: *)
+          info.exited.(info.exited_index) <- name;
+          info.exited_index <- (info.exited_index + 1) mod cache_size
+        end;
+
+        begin
+          match try Lwt.state (String_map.find name info.resolvers) with Not_found -> Sleep with
+            | Return(resolver, switch) ->
+                resolver.set_owner new_owner
+            | Fail _ | Sleep ->
+                (* Discards events arriving before GetNameOwner has returned *)
+                ()
+        end;
+
+        Some message
+    | _ ->
+        Some message
+
+let make ?switch connection name =
+  Lwt_switch.check switch;
+  OBus_string.assert_validate OBus_name.validate_bus name;
+  let info =
+    match OBus_connection.get connection key with
+      | Some info ->
+          info
+      | None ->
+          let info = {
+            resolvers = String_map.empty;
+            exited = Array.make cache_size "";
+            exited_index = 0;
+          } in
+          OBus_connection.set connection key (Some info);
+          let _ = Lwt_sequence.add_l (update_mapping info) (OBus_connection.incoming_filters connection) in
+          info
+  in
+
+  (* If [name] is a unique name and the peer has already exited, then
+     there is nothing to do: *)
+  if OBus_name.is_unique name && has_exited name info then
+    Lwt.return (S.const "")
+  else begin
+    let%lwt resolver, export_switch =
+      match try Some(String_map.find name info.resolvers) with Not_found -> None with
+        | Some thread ->
+            thread
+        | None ->
+            let waiter, wakener = Lwt.wait () in
+            info.resolvers <- String_map.add name waiter info.resolvers;
+            let export_switch = Lwt_switch.create () in
+            try%lwt
+              let%lwt () =
+                OBus_match.export
+                  ~switch:export_switch
+                  connection
+                  (OBus_match.rule
+                     ~typ:`Signal
+                     ~sender:OBus_protocol.bus_name
+                     ~interface:OBus_protocol.bus_interface
+                     ~member:"NameOwnerChanged"
+                     ~path:OBus_protocol.bus_path
+                     ~arguments:(OBus_match.make_arguments [(0, OBus_match.AF_string name)]) ())
+              in
+              let%lwt current_owner = get_name_owner connection name in
+              let owner, set_owner = S.create current_owner in
+              let resolver = { count = 0; owner; set_owner } in
+              Lwt.wakeup wakener (resolver, export_switch);
+              Lwt.return (resolver, export_switch)
+            with exn ->
+              info.resolvers <- String_map.remove name info.resolvers;
+              Lwt.wakeup_exn wakener exn;
+              let%lwt () = Lwt_switch.turn_off export_switch in
+              Lwt.fail exn
+    in
+
+    resolver.count <- resolver.count + 1;
+
+    let remove = lazy(
+      try%lwt
+        resolver.count <- resolver.count - 1;
+        if resolver.count = 0 then begin
+          (* The resolver is no more used, so we disable it: *)
+          info.resolvers <- String_map.remove name info.resolvers;
+          Lwt_switch.turn_off export_switch
+        end else
+          Lwt.return ()
+      with exn ->
+        let%lwt () = Lwt_log.warning_f ~section ~exn "failed to disable resolver for name %S" name in
+        Lwt.fail exn
+    ) in
+
+    let owner = S.with_finaliser (finalise remove) resolver.owner in
+
+    let%lwt () =
+      Lwt_switch.add_hook_or_exec
+        switch
+        (fun () ->
+           S.stop owner;
+           Lazy.force remove)
+    in
+
+    Lwt.return owner
+  end
diff --git a/src/protocol/oBus_resolver.mli b/src/protocol/oBus_resolver.mli
new file mode 100644
index 0000000..16040ad
--- /dev/null
+++ b/src/protocol/oBus_resolver.mli
@@ -0,0 +1,34 @@
+(*
+ * oBus_resolver.mli
+ * -----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Bus name resolving *)
+
+(** This module implements bus name resolving and monitoring.
+
+    - for a unique connection name, it means being notified when the
+    peer owning this name exits
+
+    - for a well-known name such as "org.domain.Serivce" it means
+    knowing at each time who is the current owner and being notified
+    when the service owner changes (i.e. the process implementing the
+    service change).
+
+    It is basically an abstraction for {!OBus_bus.get_owner} and
+    {!OBus_bus.name_owner_changed}. You should prefer using it instead
+    of implementing your own name monitoring because resolver are
+    shared and obus internally uses them, so this avoids extra messages.
+
+    Note that with a peer-to-peer connection, resolver will always act
+    as if there is no owner. *)
+
+val make : ?switch : Lwt_switch.t -> OBus_connection.t -> OBus_name.bus -> OBus_name.bus React.signal Lwt.t
+  (** [make ?switch bus name] creates a resolver which will monitor
+      the name [name] on [bus]. It returns a signal holding the
+      current owner of the name. It holds [""] when there is no
+      owner. *)
diff --git a/src/protocol/oBus_server.ml b/src/protocol/oBus_server.ml
new file mode 100644
index 0000000..cd17ae7
--- /dev/null
+++ b/src/protocol/oBus_server.ml
@@ -0,0 +1,516 @@
+(*
+ * oBus_server.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(server)"
+
+open Unix
+open Lwt.Infix
+
+(* +-----------------------------------------------------------------+
+   | Types                                                           |
+   +-----------------------------------------------------------------+ *)
+
+(* Type of a listener. A server have one or more listeners. Each
+   listener listen for new clients on a givne address *)
+type listener = {
+  lst_fd : Lwt_unix.file_descr;
+  lst_address : OBus_address.t;
+  lst_guid : OBus_address.guid;
+  lst_capabilities : OBus_auth.capability list;
+}
+
+(* Type of events received by a listener *)
+type event =
+  | Event_shutdown
+      (* Event fired when the user shutdown the server, or when a
+         listener fails. *)
+  | Event_connection of Lwt_unix.file_descr * Unix.sockaddr
+      (* A new client connects to the server *)
+
+(* Type of a server *)
+type t = {
+  mutable srv_up : bool;
+  (* The server state *)
+
+  srv_addresses : OBus_address.t list;
+  (* List of connecting addresses of the server *)
+
+  srv_callback : (t -> OBus_transport.t -> unit);
+  (* The callback function *)
+
+  srv_abort_waiter : event Lwt.t;
+  srv_abort_wakener : event Lwt.u;
+  (* Sleeping thread which is wakeup with the value [Event_shutdown]
+     when the server is shutdown *)
+
+  srv_mechanisms : OBus_auth.Server.mechanism list option;
+  (* List of mechanisms supported by this server *)
+
+  srv_allow_anonymous : bool;
+  (* Does the server allow anonymous clients ? *)
+
+  srv_nonce : string;
+  (* The server nonce, for the "tcp-nonce" transport *)
+
+  srv_nonce_file : string;
+  (* The file in which the nonce is stored *)
+
+  mutable srv_loops : unit Lwt.t;
+  (* [srv_loops] is the join of all listener's loops *)
+}
+
+(* +-----------------------------------------------------------------+
+   | Accepting new connecctions                                      |
+   +-----------------------------------------------------------------+ *)
+
+(* Reads the nonce sent by the client before authentication. The nonce
+   is composed of the first 16 bytes sent by the client. *)
+let read_nonce fd =
+  let nonce = Bytes.create 16 in
+  let rec loop ofs len =
+    Lwt_unix.read fd nonce ofs len >>= function
+      | 0 ->
+          Lwt.fail End_of_file
+      | n ->
+          if n = len then
+            Lwt.return (Bytes.unsafe_to_string nonce)
+          else
+            loop (ofs + n) (len - n)
+  in
+  loop 0 16
+
+(* Wait for a client to connects *)
+let rec accept server listener =
+  begin
+    try%lwt
+      let%lwt result = Lwt_unix.accept listener.lst_fd in
+      Lwt.return (`Accept result)
+    with Unix_error(err, _, _) ->
+      let%lwt () =
+        if server.srv_up then
+          Lwt_log.error_f ~section "uncaught error: %s" (error_message err)
+        else
+          (* Ignore errors that happens after a shutdown *)
+          Lwt.return ()
+      in
+      Lwt.return `Shutdown
+  end >>= function
+    | `Accept(fd, address) ->
+        if OBus_address.name listener.lst_address = "nonce-tcp" then begin
+          begin
+            try%lwt
+              let%lwt nonce = read_nonce fd in
+              if nonce <> server.srv_nonce then begin
+                let%lwt () = Lwt_log.notice_f ~section "client rejected because of invalid nonce" in
+                Lwt.return `Drop
+              end else
+                Lwt.return `OK
+            with
+              | End_of_file ->
+                  let%lwt () = Lwt_log.warning ~section "cannot read nonce from socket" in
+                  Lwt.return `Drop
+              | Unix.Unix_error(err, _, _) ->
+                  let%lwt () = Lwt_log.warning_f ~section "cannot read nonce from socket: %s" (Unix.error_message err) in
+                  Lwt.return `Drop
+          end >>= function
+            | `OK ->
+                Lwt.return (Event_connection(fd, address))
+            | `Drop ->
+                let%lwt () =
+                  try
+                    Lwt_unix.shutdown fd SHUTDOWN_ALL;
+                    Lwt_unix.close fd
+                  with Unix.Unix_error(err, _, _) ->
+                    Lwt_log.error_f ~section "cannot shutdown socket: %s" (Unix.error_message err)
+                in
+                accept server listener
+        end else
+          Lwt.return (Event_connection(fd, address))
+    | `Shutdown ->
+        Lwt.return Event_shutdown
+
+(* +-----------------------------------------------------------------+
+   | Listeners                                                       |
+   +-----------------------------------------------------------------+ *)
+
+(* Cleans up resources allocated for the given listenning address *)
+let cleanup address =
+  match OBus_address.name address with
+    | "unix" -> begin
+        match OBus_address.arg "path" address with
+          | Some path -> begin
+              (* Sockets in the file system must be removed manually *)
+              try
+                Lwt_unix.unlink path
+              with Unix_error(err, _, _) ->
+                Lwt_log.error_f ~section "cannot unlink '%s': %s" path (Unix.error_message err)
+            end
+          | None ->
+              Lwt.return ()
+      end
+    | _ ->
+        Lwt.return ()
+
+let string_of_address = function
+  | ADDR_UNIX path ->
+      let len = String.length path in
+      if len > 0 && path.[0] = '\x00' then
+        Printf.sprintf "unix abstract path %S" (String.sub path 1 (len - 1))
+      else
+        Printf.sprintf "unix path %S" path
+  | ADDR_INET(ia, port) ->
+      Printf.sprintf "internet address %s:%d" (string_of_inet_addr ia) port
+
+(* Handle new clients. This function never fails. *)
+let handle_client server listener fd address =
+  let shutdown = lazy(
+    try%lwt
+      Lwt_unix.shutdown fd SHUTDOWN_ALL;
+      Lwt_unix.close fd
+    with Unix.Unix_error(err, _, _) ->
+      Lwt_log.error_f ~section "cannot shutdown socket: %s" (Unix.error_message err)
+  ) in
+  try%lwt
+    let buf = Bytes.create 1 in
+    Lwt_unix.read fd buf 0 1 >>= function
+      | 0 ->
+          Lwt.fail (OBus_auth.Auth_failure "did not receive the initial null byte")
+      | 1 ->
+          let user_id =
+            try
+              Some((Lwt_unix.get_credentials fd).Lwt_unix.cred_uid)
+            with Unix.Unix_error(error, _, _) ->
+              ignore (Lwt_log.info_f ~section "cannot read credential: %s" (Unix.error_message error));
+              None
+          in
+          let%lwt user_id, capabilities =
+            OBus_auth.Server.authenticate
+              ~capabilities:listener.lst_capabilities
+              ?mechanisms:server.srv_mechanisms
+              ?user_id
+              ~guid:listener.lst_guid
+              ~stream:(OBus_auth.stream_of_fd fd)
+              ()
+          in
+          if user_id = None && not server.srv_allow_anonymous then begin
+            let%lwt () = Lwt_log.notice_f ~section "client from %s rejected because anonymous connections are not allowed" (string_of_address address) in
+            Lazy.force shutdown
+          end else begin
+            try
+              server.srv_callback server (OBus_transport.socket ~capabilities fd);
+              Lwt.return ()
+            with exn ->
+              let%lwt () = Lwt_log.error ~section ~exn "server callback failed failed with" in
+              Lazy.force shutdown
+          end
+      | _ ->
+          assert false
+  with exn ->
+    let%lwt () =
+      match exn with
+        | OBus_auth.Auth_failure msg ->
+            Lwt_log.notice_f ~section "authentication failure for client from %s: %s" (string_of_address address) msg
+        | exn ->
+            Lwt_log.error_f ~section ~exn "authentication for client from %s failed with" (string_of_address address)
+    in
+    Lazy.force shutdown
+
+(* Accept clients until the server is shutdown, or an accept fails: *)
+let rec lst_loop server listener =
+  Lwt.pick [server.srv_abort_waiter; accept server listener] >>= function
+    | Event_shutdown ->
+        let%lwt () =
+          try
+            Lwt_unix.close listener.lst_fd
+          with Unix_error(err, _, _) ->
+            Lwt_log.error_f ~section "cannot close listenning socket: %s" (Unix.error_message err)
+        in
+        cleanup listener.lst_address
+
+    | Event_connection(fd, address) ->
+        (* Launch authentication and dispatching in parallel: *)
+        ignore (handle_client server listener fd address);
+        lst_loop server listener
+
+(* +-----------------------------------------------------------------+
+   | Address -> transport                                            |
+   +-----------------------------------------------------------------+ *)
+
+(* Tries to create a socket using the given parameters *)
+let make_socket domain typ address =
+  let fd = Lwt_unix.socket domain typ 0 in
+  (try Lwt_unix.set_close_on_exec fd with _ -> ());
+  try
+    let%lwt () = Lwt_unix.bind fd address in
+    Lwt_unix.listen fd 10;
+    Lwt.return fd
+  with Unix_error(err, _, _) as exn ->
+    let%lwt () = Lwt_log.error_f ~section "failed to create listenning socket with %s: %s" (string_of_address address) (Unix.error_message err) in
+    let%lwt () = Lwt_unix.close fd in
+    Lwt.fail exn
+
+let make_path path =
+  make_socket PF_UNIX SOCK_STREAM (ADDR_UNIX(path))
+
+let make_abstract path =
+  make_socket PF_UNIX SOCK_STREAM (ADDR_UNIX("\x00" ^ path))
+
+(* Takes a D-Bus listenning address and returns the list of [(fd,
+   client-address)] it denotes *)
+let fd_addr_list_of_address address = match OBus_address.name address with
+  | "unix" -> begin
+      match (OBus_address.arg "path" address,
+             OBus_address.arg "abstract" address,
+             OBus_address.arg "tmpdir" address) with
+        | Some path, None, None ->
+            let%lwt fd = make_path path in
+            Lwt.return [(fd, address)]
+        | None, Some abst, None ->
+            let%lwt fd = make_abstract abst in
+            Lwt.return [(fd, address)]
+        | None, None, Some tmpd -> begin
+            let path = Filename.concat tmpd ("obus-" ^ OBus_util.hex_encode (OBus_util.random_string 10)) in
+            (* Try with abstract name first *)
+            try%lwt
+              let%lwt fd = make_abstract path in
+              Lwt.return [(fd, OBus_address.make ~name:"unix" ~args:[("abstract", path)])]
+            with exn ->
+              (* And fallback to path in the filesystem *)
+              let%lwt fd = make_path path in
+              Lwt.return [(fd, OBus_address.make ~name:"unix" ~args:[("path", path)])]
+          end
+        | _ ->
+            Lwt.fail (Invalid_argument "OBus_transport.connect: invalid unix address, must supply exactly one of 'path', 'abstract', 'tmpdir'")
+    end
+
+  | ("tcp" | "nonce-tcp") as name -> begin
+      let port = match OBus_address.arg "port" address with
+        | Some port -> port
+        | None -> "0"
+      and bind = match OBus_address.arg "bind" address with
+        | Some bind -> bind
+        | None -> match OBus_address.arg "host" address with
+            | Some host -> host
+            | None -> "*"
+      in
+      let opts = [AI_SOCKTYPE SOCK_STREAM; AI_PASSIVE] in
+      let opts = match OBus_address.arg "family" address with
+        | Some "ipv4" -> AI_FAMILY PF_INET :: opts
+        | Some "ipv6" -> AI_FAMILY PF_INET6 :: opts
+        | Some family -> Printf.ksprintf invalid_arg "OBus_server.make_server: unknown address family '%s'" family
+        | None -> opts
+      in
+      let ais = getaddrinfo bind port opts in
+      (* Remove duplicate address info: *)
+      let module AI_set = Set.Make(struct type t  = addr_info let compare = compare end) in
+      let ais = AI_set.elements (List.fold_left (fun set ai -> AI_set.add ai set) AI_set.empty ais) in
+      match ais with
+        | [] ->
+            Printf.ksprintf
+              failwith
+              "OBus_transport.make_server: no address info for bind=%s port=%s%s"
+              bind port
+              (match OBus_address.arg "family" address with
+                 | None -> ""
+                 | Some f -> " family=" ^ f)
+        | ais ->
+            let%lwt results = Lwt_list.map_p
+              (fun ai ->
+                 try%lwt
+                   let%lwt fd = make_socket ai.ai_family ai.ai_socktype ai.ai_addr in
+                   match getsockname (Lwt_unix.unix_file_descr fd) with
+                     | ADDR_UNIX path ->
+                         assert false
+                     | ADDR_INET(host, port) ->
+                         Lwt.return (`Success(fd, OBus_address.make ~name ~args:[("host", string_of_inet_addr host);
+                                                                             ("port", string_of_int port);
+                                                                             ("family",
+                                                                              match ai.ai_family with
+                                                                                | PF_UNIX -> assert false
+                                                                                | PF_INET -> "ipv4"
+                                                                                | PF_INET6 -> "ipv6")]))
+                 with exn ->
+                   Lwt.return (`Failure exn))
+              ais
+            in
+            let fd_addr_list =
+              OBus_util.filter_map
+                (function
+                   | `Success x -> Some x
+                   | `Failure _ -> None)
+                results
+            in
+            if fd_addr_list = [] then
+              (* If no fds have been created, raises the first failure: *)
+              match OBus_util.find_map (function `Failure e -> Some e | `Success _ -> None) results with
+                | Some exn -> Lwt.fail exn
+                | None -> assert false
+            else
+              Lwt.return fd_addr_list
+    end
+
+  | "autolaunch" ->
+      Lwt.fail (Failure "OBus_server.make_server: autolaunch can not be used as a listenning address")
+
+  | name ->
+      Lwt.fail (Failure ("OBus_server.make_server: unknown transport type: " ^ name))
+
+(* +-----------------------------------------------------------------+
+   | Servers                                                         |
+   +-----------------------------------------------------------------+ *)
+
+let addresses server = server.srv_addresses
+
+let shutdown server =
+  if server.srv_up then begin
+    server.srv_up <- false;
+    Lwt.wakeup server.srv_abort_wakener Event_shutdown;
+    let%lwt () =
+      if server.srv_nonce_file <> "" then begin
+        try
+          Lwt_unix.unlink server.srv_nonce_file
+        with Unix_error(err, _, _) ->
+          Lwt_log.error_f ~section "cannot unlink '%s': %s" server.srv_nonce_file (Unix.error_message err)
+      end else
+        Lwt.return ()
+    in
+    (* Wait for all listenners to exit: *)
+    server.srv_loops
+  end else
+    server.srv_loops
+
+let default_address = OBus_address.make ~name:"unix" ~args:[("tmpdir", Filename.get_temp_dir_name ())]
+
+let make_lowlevel ?switch ?(capabilities=OBus_auth.capabilities) ?mechanisms ?(addresses=[default_address]) ?(allow_anonymous=false) callback =
+  Lwt_switch.check switch;
+  match addresses with
+    | [] ->
+        Lwt.fail (Invalid_argument "OBus_server.make: no addresses given")
+
+    | addresses ->
+        (* Construct the list of all listening fds for each
+           address: *)
+        let%lwt result_by_address =
+          Lwt_list.map_p
+            (fun address ->
+               try%lwt
+                 let%lwt x = fd_addr_list_of_address address in
+                 Lwt.return (`Success x)
+               with e ->
+                 Lwt.return (`Failure e))
+            addresses
+        in
+
+        (* Close all listening file descriptors and fail: *)
+        let abort exn =
+          let%lwt () =
+            Lwt_list.iter_p
+              (function
+                 | `Success fd_addr_list ->
+                     Lwt_list.iter_p
+                       (fun (fd, address) ->
+                          try%lwt
+                            let%lwt () = Lwt_unix.close fd in
+                            cleanup address
+                          with Unix_error(err, _, _) ->
+                            Lwt_log.error_f ~section "failed to close listenning file descriptor: %s" (Unix.error_message err))
+                       fd_addr_list
+                 | `Failure e ->
+                     Lwt.return ())
+              result_by_address
+          in
+          Lwt.fail exn
+        in
+
+        match OBus_util.find_map (function `Success _ -> None | `Failure e -> Some e) result_by_address with
+          | Some exn ->
+              abort exn
+
+          | None ->
+              let%lwt nonce, nonce_file =
+                if List.exists (fun addr -> OBus_address.name addr = "nonce-tcp") addresses then begin
+                  let nonce = OBus_util.random_string 16 in
+                  let file_name = Filename.concat (Filename.get_temp_dir_name ()) ("obus-" ^ OBus_util.hex_encode (OBus_util.random_string 10)) in
+                  try%lwt
+                    let%lwt () = Lwt_io.with_file ~mode:Lwt_io.output file_name (fun oc -> Lwt_io.write oc nonce) in
+                    Lwt.return (nonce, file_name)
+                  with Unix.Unix_error(err, _, _) ->
+                    abort (Failure(Printf.sprintf "cannot create nonce file '%s': %s" file_name (Unix.error_message err)))
+                end else
+                  Lwt.return ("", "")
+              in
+
+              let successes =
+                List.map
+                  (function
+                     | `Failure _ -> assert false
+                     | `Success x -> x)
+                  result_by_address
+              in
+
+              let guids = List.map (fun _ -> OBus_uuid.generate ()) successes in
+
+              let successes =
+                List.map2
+                  (fun fd_addr_list guid ->
+                     List.map
+                       (fun (fd, addr) ->
+                          let args = ("guid", OBus_uuid.to_string guid) :: OBus_address.args addr in
+                          let args =
+                            if OBus_address.name addr = "nonce-tcp" then
+                              ("noncefile", nonce_file) :: args
+                            else
+                              args
+                          in
+                          (fd, { addr with OBus_address.args = args }))
+                       fd_addr_list)
+                  successes guids
+              in
+
+              let listeners = List.flatten
+                (List.map2
+                   (fun fd_addr_list guid ->
+                      List.map
+                        (fun (fd, address) -> {
+                           lst_fd = fd;
+                           lst_address = address;
+                           lst_capabilities = (List.filter
+                                                 (fun `Unix_fd ->
+                                                    match (OBus_address.arg "path" address,
+                                                           OBus_address.arg "abstract" address) with
+                                                      | None, None -> false
+                                                      | _ -> true)
+                                                 capabilities);
+                           lst_guid = guid;
+                         })
+                        fd_addr_list)
+                   successes guids)
+              in
+
+              let abort_waiter, abort_wakener = Lwt.wait () in
+              let server = {
+                srv_up = true;
+                srv_addresses = List.map snd (List.flatten successes);
+                srv_callback = callback;
+                srv_abort_waiter = abort_waiter;
+                srv_abort_wakener = abort_wakener;
+                srv_mechanisms = mechanisms;
+                srv_allow_anonymous = allow_anonymous;
+                srv_nonce = nonce;
+                srv_nonce_file = nonce_file;
+                srv_loops = Lwt.return ();
+              } in
+              server.srv_loops <- Lwt.join (List.map (fun listener -> lst_loop server listener) listeners);
+
+              let%lwt () = Lwt_switch.add_hook_or_exec switch (fun () -> shutdown server) in
+              Lwt.return server
+
+let make ?switch ?capabilities ?mechanisms ?addresses ?allow_anonymous callback =
+  make_lowlevel ?switch ?capabilities ?mechanisms ?addresses ?allow_anonymous
+    (fun server transport -> callback server (OBus_connection.of_transport ~up:false transport))
diff --git a/src/protocol/oBus_server.mli b/src/protocol/oBus_server.mli
new file mode 100644
index 0000000..14ae219
--- /dev/null
+++ b/src/protocol/oBus_server.mli
@@ -0,0 +1,72 @@
+(*
+ * oBus_server.mli
+ * ---------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Servers for one-to-one communication *)
+
+type t
+  (** Type of a server *)
+
+val addresses : t -> OBus_address.t list
+  (** [addresses server] returns all the addresses the server is
+      listenning on. These addresses must be passed to clients so they
+      can connect to [server]. *)
+
+val shutdown : t -> unit Lwt.t
+  (** [shutdown server] shutdowns the given server. It terminates when
+      all listeners (a server may listen on several addresses) have
+      exited. If the server has already been shut down, it does
+      nothing. *)
+
+val make :
+  ?switch : Lwt_switch.t ->
+  ?capabilities : OBus_auth.capability list ->
+  ?mechanisms : OBus_auth.Server.mechanism list ->
+  ?addresses : OBus_address.t list ->
+  ?allow_anonymous : bool ->
+  (t -> OBus_connection.t -> unit) -> t Lwt.t
+  (** [make ?switch ?capabilities ?mechanisms ?addresses ?allow_anonymous f]
+      Creates a server which will listen on all of the given addresses.
+
+      @param capabilites is the set of the server's capabilities,
+      @param mechanisms is the list of authentication mechanisms
+             supported by the server,
+      @param addresses default to
+             [{ name = "unix"; args = [("tmpdir", "/tmp")]],
+      @param allow_anonymous tell whether clients using anonymous
+             authentication will be accepted. It defaults to [false],
+      @param capabilities is the list of supported capabilities, it
+             defaults to {!OBus_auth.capabilities}
+      @param f is the callback which receive new clients. It takes
+             as arguments the server and the connection for the client.
+
+      About errors:
+      - if no addresses are provided, it raises [Invalid_argument],
+      - if an address is invalid, it raises [Invalid_argument]
+      - if listening fails for one of the addresses, it fails with the
+        exception reported for that address
+
+      It succeeds if it can listen on at least one address.
+
+      When a new client connects, the server handles authentication of
+      this client, then it creates a transport and the connection on
+      top of this transport.
+
+      Note that connections passed to [f] are initially down. It is up
+      to the user to set them up with {!OBus_connection.set_up}. *)
+
+val make_lowlevel :
+  ?switch : Lwt_switch.t ->
+  ?capabilities : OBus_auth.capability list ->
+  ?mechanisms : OBus_auth.Server.mechanism list ->
+  ?addresses : OBus_address.t list ->
+  ?allow_anonymous : bool ->
+  (t -> OBus_transport.t -> unit) -> t Lwt.t
+  (** [make_lowlevel] is the same as {!make} except that [f] receives
+      only the transport, and no connection is created for this
+      transport. *)
diff --git a/src/protocol/oBus_signal.ml b/src/protocol/oBus_signal.ml
new file mode 100644
index 0000000..b9a3542
--- /dev/null
+++ b/src/protocol/oBus_signal.ml
@@ -0,0 +1,292 @@
+(*
+ * oBus_signal.ml
+ * --------------
+ * Copyright : (c) 2010, 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(signal)"
+
+open Lwt_react
+
+(* +-----------------------------------------------------------------+
+   | Signal descriptors                                              |
+   +-----------------------------------------------------------------+ *)
+
+type 'a t = {
+  interface : OBus_name.interface;
+  (* The interface of the signal. *)
+
+  member : OBus_name.member;
+  (* The name of the signal. *)
+
+  peer : OBus_peer.t;
+  (* The peer emitting the signal. *)
+
+  path : OBus_path.t option;
+  (* The path of the object emitting the signa or [None] if we want to
+     match signals comming from any objects. *)
+
+  map : (OBus_context.t * OBus_path.t * OBus_value.V.sequence) event -> (OBus_context.t * 'a) event;
+  (* The function which maps the event into an event holding values of
+     type ['a]. *)
+
+  filters : OBus_match.arguments;
+  (* Argument filters. *)
+
+  match_rule : bool;
+  (* Whether the managed mode for the match rule is enabled *)
+}
+
+let empty_filters = OBus_match.make_arguments []
+
+(* Cast a message body into an ocaml value: *)
+let cast signal (context, path, body) =
+  try
+    Some(context,
+         OBus_value.C.cast_sequence
+           (OBus_value.arg_types
+              (OBus_member.Signal.args signal))
+           body)
+  with OBus_value.C.Signature_mismatch ->
+    ignore (
+      Lwt_log.error_f ~section "failed to cast signal from %S, interface %S, member %S with signature %S to %S"
+        (OBus_peer.name (OBus_context.sender context))
+        (OBus_member.Signal.interface signal)
+        (OBus_member.Signal.member signal)
+        (OBus_value.string_of_signature
+           (OBus_value.V.type_of_sequence body))
+        (OBus_value.string_of_signature
+           (OBus_value.C.type_sequence
+              (OBus_value.arg_types
+                 (OBus_member.Signal.args signal))))
+    );
+    None
+
+let cast_any signal (context, path, body) =
+  match cast signal (context, path, body) with
+    | Some(context, v) -> Some(context, (OBus_proxy.make (OBus_context.sender context) path, v))
+    | None -> None
+
+let make signal proxy = {
+  interface = OBus_member.Signal.interface signal;
+  member = OBus_member.Signal.member signal;
+  peer = OBus_proxy.peer proxy;
+  path = Some(OBus_proxy.path proxy);
+  map = E.fmap (cast signal);
+  filters = empty_filters;
+  match_rule = OBus_connection.name (OBus_proxy.connection proxy) <> "";
+}
+
+let make_any signal peer = {
+  interface = OBus_member.Signal.interface signal;
+  member = OBus_member.Signal.member signal;
+  peer = peer;
+  path = None;
+  map = E.fmap (cast_any signal);
+  filters = empty_filters;
+  match_rule = OBus_connection.name (OBus_peer.connection peer) <> "";
+}
+
+(* +-----------------------------------------------------------------+
+   | Signals transformations and parameters                          |
+   +-----------------------------------------------------------------+ *)
+
+let map_event f sd =
+  { sd with map = fun event -> f (sd.map event) }
+
+let map f sd =
+  { sd with map = fun event -> E.map (fun (context, value) -> (context, f value)) (sd.map event) }
+
+let map_with_context f sd =
+  { sd with map = fun event -> E.map (fun (context, value) -> (context, f context value)) (sd.map event) }
+
+let with_context sd =
+  { sd with map = fun event -> E.map (fun (context, value) -> (context, (context, value))) (sd.map event) }
+
+let with_filters filters sd =
+  { sd with filters }
+
+let with_match_rule match_rule sd =
+  { sd with match_rule }
+
+(* +-----------------------------------------------------------------+
+   | Signals dispatching                                             |
+   +-----------------------------------------------------------------+ *)
+
+module Signal_map = Map.Make
+  (struct
+     type t = OBus_path.t option * OBus_name.interface * OBus_name.member
+     let compare = Pervasives.compare
+   end)
+
+type info = {
+  mutable senders : (OBus_context.t * OBus_path.t * OBus_value.V.sequence -> unit) Lwt_sequence.t Signal_map.t;
+}
+
+let dispatch connection info message =
+  match OBus_message.typ message with
+    | OBus_message.Signal(path, interface, member) ->
+        begin
+          match try Some(Signal_map.find (Some path, interface, member) info.senders) with Not_found -> None with
+            | Some senders ->
+                Lwt_sequence.iter_l
+                  (fun send ->
+                     try
+                       send (OBus_context.make connection message, path, OBus_message.body message)
+                     with exn ->
+                       ignore (Lwt_log.error ~section ~exn "signal event failed with"))
+                  senders
+            | None ->
+                ()
+        end;
+        begin
+          match try Some(Signal_map.find (None, interface, member) info.senders) with Not_found -> None with
+            | Some senders ->
+                Lwt_sequence.iter_l
+                  (fun send ->
+                     try
+                       send (OBus_context.make connection message, path, OBus_message.body message)
+                     with exn ->
+                       ignore (Lwt_log.error ~section ~exn "signal event failed with"))
+                  senders
+            | None ->
+                ()
+        end;
+        Some message
+    | _ ->
+        Some message
+
+(* +-----------------------------------------------------------------+
+   | Signals connection                                              |
+   +-----------------------------------------------------------------+ *)
+
+let finalise disconnect _ =
+  ignore (Lazy.force disconnect)
+
+let key = OBus_connection.new_key ()
+
+let connect ?switch sd =
+  Lwt_switch.check switch;
+  let connection = OBus_peer.connection sd.peer and name = OBus_peer.name sd.peer in
+
+  (* Switch freeing resources allocated for this signal: *)
+  let resources_switch = Lwt_switch.create () in
+
+  try%lwt
+    (* Add the match rule if requested: *)
+    let%lwt () =
+      if sd.match_rule then
+        OBus_match.export
+          ~switch:resources_switch
+          connection
+          (OBus_match.rule
+             ~typ:`Signal
+             ~sender:name
+             ?path:sd.path
+             ~interface:sd.interface
+             ~member:sd.member
+             ())
+      else
+        Lwt.return ()
+
+    (* Plus the resolver if needed: *)
+    and owner_option =
+      if OBus_connection.name connection <> "" && name <> "" then
+        if OBus_name.is_unique name then
+          Lwt.return (Some (S.const name))
+        else
+          let%lwt owner = OBus_resolver.make ~switch:resources_switch connection name in
+          Lwt.return (Some owner)
+      else
+        Lwt.return None
+    in
+
+    let info =
+      match OBus_connection.get connection key with
+        | Some info ->
+            info
+        | None ->
+            let info = {
+              senders = Signal_map.empty;
+            } in
+            OBus_connection.set connection key (Some info);
+            let _ = Lwt_sequence.add_l (dispatch connection info) (OBus_connection.incoming_filters connection) in
+            info
+    in
+
+    let senders =
+      match try Some(Signal_map.find (sd.path, sd.interface, sd.member) info.senders) with Not_found -> None with
+        | Some senders ->
+            senders
+        | None ->
+            let senders = Lwt_sequence.create () in
+            info.senders <- Signal_map.add (sd.path, sd.interface, sd.member) senders info.senders;
+            senders
+    in
+
+    let event, send = E.create () in
+    let send v = send v in
+    let node = Lwt_sequence.add_r send senders in
+
+    let event =
+      E.filter
+        (fun (context, path, body) ->
+           match owner_option with
+             | Some owner when S.value owner <> OBus_peer.name (OBus_context.sender context) ->
+                 false
+             | _ ->
+                 OBus_match.match_values sd.filters body)
+        event
+    in
+
+    let disconnect = lazy(
+      try%lwt
+        Lwt_sequence.remove node;
+        if Lwt_sequence.is_empty senders then
+          info.senders <- Signal_map.remove (sd.path, sd.interface, sd.member) info.senders;
+        Lwt_switch.turn_off resources_switch
+      with exn ->
+        let%lwt () =
+          Lwt_log.warning_f
+            ~section
+            ~exn
+            "failed to disconnect signal \"%s.%s\" of object \"%s\" from \"%s\""
+            sd.interface
+            sd.member
+            (match sd.path with
+               | Some path -> OBus_path.to_string path
+               | None -> "<any>")
+            (OBus_peer.name sd.peer)
+        in
+        Lwt.fail exn
+    ) in
+
+    let event = E.with_finaliser (finalise disconnect) (E.map snd (sd.map event)) in
+
+    let%lwt () =
+      Lwt_switch.add_hook_or_exec
+        switch
+        (fun () ->
+           E.stop event;
+           Lazy.force disconnect)
+    in
+
+    Lwt.return event
+  with exn ->
+    let%lwt () = Lwt_switch.turn_off resources_switch in
+    Lwt.fail exn
+
+(* +-----------------------------------------------------------------+
+   | Emitting signals                                                |
+   +-----------------------------------------------------------------+ *)
+
+let emit info obj ?peer args =
+  OBus_object.emit obj
+    ~interface:(OBus_member.Signal.interface info)
+    ~member:(OBus_member.Signal.member info)
+    ?peer
+    (OBus_value.arg_types (OBus_member.Signal.args info))
+    args
diff --git a/src/protocol/oBus_signal.mli b/src/protocol/oBus_signal.mli
new file mode 100644
index 0000000..4107fb4
--- /dev/null
+++ b/src/protocol/oBus_signal.mli
@@ -0,0 +1,78 @@
+(*
+ * oBus_signal.mli
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus signals *)
+
+(** {6 Emitting signals} *)
+
+val emit : 'a OBus_member.Signal.t -> 'b OBus_object.t -> ?peer : OBus_peer.t -> 'a -> unit Lwt.t
+  (** [emit signal obj ?peer args] emits [signal] from [obj]. The
+      destinations of the signal are selected as follow:
+
+      - if [peer] is provided, then the message is sent only to it
+      - otherwise, if the the object has an owner, it is sent to the owner,
+      - otherwise, the message is broadcasted on all the connections [obj]
+        is exported on.
+  *)
+
+(** {6 Receving signals} *)
+
+type 'a t
+  (** Type of a signal descriptor. A signal descriptor represent the
+      source of a signal and describes how the value should be
+      transformed. *)
+
+val make : 'a OBus_member.Signal.t -> OBus_proxy.t -> 'a t
+  (** [make signal proxy] creates a signal descriptor. *)
+
+val make_any : 'a OBus_member.Signal.t -> OBus_peer.t -> (OBus_proxy.t * 'a) t
+  (** [make_any signal peer] creates a signal descriptor for receiving
+      signals from any object of [peer]. *)
+
+val connect : ?switch : Lwt_switch.t -> 'a t -> 'a React.event Lwt.t
+  (** [connect ?switch sd] connects the signal descriptor [sd] and
+      returns the event which occurs when the given D-Bus signal is
+      received. *)
+
+(** {6 Signals transformations and parameters} *)
+
+val map_event : ((OBus_context.t * 'a) React.event -> (OBus_context.t * 'b) React.event) -> 'a t -> 'b t
+  (** [map_event f sd] transforms with [f] the event that is created
+      when [sd] is connected. *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+  (** Simplified version of {!map_event}. *)
+
+val map_with_context : (OBus_context.t -> 'a -> 'b) -> 'a t -> 'b t
+  (** Same as {!map} but the mapping function also receive the
+      context. *)
+
+val with_context : 'a t -> (OBus_context.t * 'a) t
+  (** @return a signal descriptor that returns contexts in which
+      signals are received. *)
+
+val with_filters : OBus_match.arguments -> 'a t -> 'a t
+  (** [with_filters filters sd] is the signal descriptor [sd] with the
+      given list of argument filters. When connected, obus will add
+      this filters to the matching rule send to the message bus, so
+      the bus can use them to drop messages that do not match these
+      filters.
+
+      The goal of argument filters is to reduce the number of messages
+      received, and so to reduce the number of wakeup of the
+      program.
+
+      Note that match rule management must be activated for filters to
+      take effect (see {!with_match_rule}).  *)
+
+val with_match_rule : bool -> 'a t -> 'a t
+  (** [with_match_rule state sd] enables or disables the automatic
+      management of matching rules. If the endpoint of the underlying
+      connection is a message bus it defaults to [true], otherwise it
+      default to [false]. *)
diff --git a/src/protocol/oBus_transport.ml b/src/protocol/oBus_transport.ml
new file mode 100644
index 0000000..de6ca9a
--- /dev/null
+++ b/src/protocol/oBus_transport.ml
@@ -0,0 +1,292 @@
+(*
+ * oBus_transport.ml
+ * -----------------
+ * Copyright : (c) 2009, 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(transport)"
+
+open Unix
+open Printf
+open OBus_address
+open Lwt.Infix
+
+(* +-----------------------------------------------------------------+
+   | Types and constructors                                          |
+   +-----------------------------------------------------------------+ *)
+
+type t = {
+  recv : unit -> OBus_message.t Lwt.t;
+  send : OBus_message.t -> unit Lwt.t;
+  capabilities : OBus_auth.capability list;
+  shutdown : unit -> unit Lwt.t;
+}
+
+let make ?switch ~recv ~send ?(capabilities=[]) ~shutdown () =
+  let transport = {
+    recv = recv;
+    send = send;
+    capabilities = capabilities;
+    shutdown = shutdown;
+  } in
+  Lwt_switch.add_hook switch transport.shutdown;
+  transport
+
+let recv t = t.recv ()
+let send t message = t.send message
+let capabilities t = t.capabilities
+let shutdown t = t.shutdown ()
+
+(* +-----------------------------------------------------------------+
+   | Socket transport                                                |
+   +-----------------------------------------------------------------+ *)
+
+let socket ?switch ?(capabilities=[]) fd =
+  let transport =
+    if List.mem `Unix_fd capabilities then
+      let reader = OBus_wire.reader fd
+      and writer = OBus_wire.writer fd in
+      { recv = (fun _ -> OBus_wire.read_message_with_fds reader);
+        send = (fun msg -> OBus_wire.write_message_with_fds writer msg);
+        capabilities = capabilities;
+        shutdown = (fun _ ->
+                      let%lwt () = OBus_wire.close_reader reader <&> OBus_wire.close_writer writer in
+                      Lwt_unix.shutdown fd SHUTDOWN_ALL;
+                      Lwt_unix.close fd) }
+    else
+      let ic = Lwt_io.of_fd ~mode:Lwt_io.input ~close:Lwt.return fd
+      and oc = Lwt_io.of_fd ~mode:Lwt_io.output ~close:Lwt.return fd in
+      { recv = (fun _ -> OBus_wire.read_message ic);
+        send = (fun msg -> OBus_wire.write_message oc msg);
+        capabilities = capabilities;
+        shutdown = (fun _ ->
+                      let%lwt () = Lwt_io.close ic <&> Lwt_io.close oc in
+                      Lwt_unix.shutdown fd SHUTDOWN_ALL;
+                      Lwt_unix.close fd) }
+  in
+  Lwt_switch.add_hook switch transport.shutdown;
+  transport
+
+(* +-----------------------------------------------------------------+
+   | Loopback transport                                              |
+   +-----------------------------------------------------------------+ *)
+
+let loopback () =
+  let mvar = Lwt_mvar.create_empty () in
+  { recv = (fun _ -> Lwt_mvar.take mvar);
+    send = (fun m -> Lwt_mvar.put mvar { m with OBus_message.body = OBus_value.V.sequence_dup (OBus_message.body m) });
+    capabilities = [`Unix_fd];
+    shutdown = Lwt.return }
+
+(* +-----------------------------------------------------------------+
+   | Addresses -> transport                                          |
+   +-----------------------------------------------------------------+ *)
+
+let make_socket domain typ addr =
+  let fd = Lwt_unix.socket domain typ 0 in
+  (try Lwt_unix.set_close_on_exec fd with _ -> ());
+  try%lwt
+    let%lwt () = Lwt_unix.connect fd addr in
+    Lwt.return (fd, domain)
+  with exn ->
+    let%lwt () = Lwt_unix.close fd in
+    Lwt.fail exn
+
+let rec write_nonce fd nonce pos len =
+  Lwt_unix.write_string fd nonce 0 16 >>= function
+    | 0 ->
+        Lwt.fail (Failure "OBus_transport.connect: failed to send the nonce to the server")
+    | n ->
+        if n = len then
+          Lwt.return ()
+        else
+          write_nonce fd nonce (pos + n) (len - n)
+
+let make_socket_nonce nonce_file domain typ addr =
+  match nonce_file with
+    | None ->
+        Lwt.fail (Invalid_argument "OBus_transport.connect: missing 'noncefile' parameter")
+    | Some file_name ->
+        let%lwt nonce =
+          try%lwt
+            Lwt_io.with_file ~mode:Lwt_io.input file_name (Lwt_io.read ~count:16)
+          with
+            | Unix.Unix_error(err, _, _) ->
+                Lwt.fail (Failure(Printf.sprintf "failed to read the nonce file '%s': %s" file_name (Unix.error_message err)))
+            | End_of_file ->
+                Lwt.fail (Failure(Printf.sprintf "OBus_transport.connect: '%s' is an invalid nonce-file" file_name))
+        in
+        if String.length nonce <> 16 then
+          Lwt.fail (Failure(Printf.sprintf "OBus_transport.connect: '%s' is an invalid nonce-file" file_name))
+        else begin
+          let%lwt fd, domain = make_socket domain typ addr in
+          let%lwt () = write_nonce fd nonce 0 16 in
+          Lwt.return (fd, domain)
+        end
+
+let rec connect address =
+  match OBus_address.name address with
+    | "unix" -> begin
+        match (OBus_address.arg "path" address,
+               OBus_address.arg "abstract" address,
+               OBus_address.arg "tmpdir" address) with
+          | Some path, None, None ->
+              make_socket PF_UNIX SOCK_STREAM (ADDR_UNIX path)
+          | None, Some abst, None ->
+              make_socket PF_UNIX SOCK_STREAM (ADDR_UNIX("\x00" ^ abst))
+          | None, None, Some tmpd ->
+              Lwt.fail (Invalid_argument "OBus_transport.connect: unix tmpdir can only be used as a listening address")
+          | _ ->
+              Lwt.fail (Invalid_argument "OBus_transport.connect: invalid unix address, must supply exactly one of 'path', 'abstract', 'tmpdir'")
+      end
+    | ("tcp" | "nonce-tcp") as name -> begin
+        let host = match OBus_address.arg "host" address with
+          | Some host -> host
+          | None -> ""
+        and port = match OBus_address.arg "port" address with
+          | Some port -> port
+          | None -> "0"
+        in
+        let opts = [AI_SOCKTYPE SOCK_STREAM] in
+        let opts = match OBus_address.arg "family" address with
+          | Some "ipv4" -> AI_FAMILY PF_INET :: opts
+          | Some "ipv6" -> AI_FAMILY PF_INET6 :: opts
+          | Some family -> Printf.ksprintf invalid_arg "OBus_transport.connect: unknown address family '%s'" family
+          | None -> opts
+        in
+        Lwt_unix.getaddrinfo host port opts >>= function
+          | [] ->
+              Lwt.fail
+                (Failure
+                   (Printf.sprintf
+                      "OBus_transport.connect: no address info for host=%s port=%s%s"
+                      host port
+                      (match OBus_address.arg "family" address with
+                         | None -> ""
+                         | Some f -> " family=" ^ f)))
+          | ai :: ais ->
+              let make_socket =
+                if name = "nonce-tcp" then
+                  make_socket_nonce (OBus_address.arg "noncefile" address)
+                else
+                  make_socket
+              in
+              try%lwt
+                make_socket ai.ai_family ai.ai_socktype ai.ai_addr
+              with exn ->
+                (* If the first connection failed, try with all the
+                   other ones: *)
+                let rec find = function
+                  | [] ->
+                      (* If all connection failed, raise the error for
+                         the first address: *)
+                      Lwt.fail exn
+                  | ai :: ais ->
+                      try%lwt
+                        make_socket ai.ai_family ai.ai_socktype ai.ai_addr
+                      with exn ->
+                        find ais
+                in
+                find ais
+      end
+    | "launchd" -> begin
+        match OBus_address.arg "env" address with
+          | Some env ->
+              let%lwt path =
+                try%lwt
+                  Lwt_process.pread_line ("launchctl", [|"launchctl"; "getenv"; env|])
+                with exn ->
+                  let%lwt () = Lwt_log.error_f ~exn ~section "launchctl failed" in
+                  Lwt.fail exn
+              in
+              make_socket PF_UNIX SOCK_STREAM (ADDR_UNIX path)
+          | None ->
+              Lwt.fail (Invalid_argument "OBus_transport.connect: missing 'env' in launchd address")
+      end
+    | "autolaunch" -> begin
+        let%lwt addresses =
+          let%lwt uuid = Lazy.force OBus_info.machine_uuid in
+          let%lwt line =
+            try%lwt
+              Lwt_process.pread_line ("dbus-launch", [|"dbus-launch"; "--autolaunch"; OBus_uuid.to_string uuid; "--binary-syntax"|])
+            with exn ->
+              let%lwt () = Lwt_log.error_f ~exn ~section "autolaunch failed" in
+              Lwt.fail exn
+          in
+          let line = try String.sub line 0 (String.index line '\000') with _ -> line in
+          try%lwt
+            Lwt.return (OBus_address.of_string line)
+          with OBus_address.Parse_failure(addr, pos, reason) as exn ->
+            let%lwt () = Lwt_log.error_f ~section "autolaunch returned an invalid address %S, at position %d: %s" addr pos reason in
+            Lwt.fail exn
+        in
+        match addresses with
+          | [] ->
+              let%lwt () = Lwt_log.error_f ~section "'autolaunch' returned no addresses" in
+              Lwt.fail (Failure "'autolaunch' returned no addresses")
+          | address :: rest ->
+              try%lwt
+                connect address
+              with exn ->
+                let rec find = function
+                  | [] ->
+                      Lwt.fail exn
+                  | address :: rest ->
+                      try%lwt
+                        connect address
+                      with exn ->
+                        find rest
+                in
+                find rest
+      end
+
+    | name ->
+        Lwt.fail (Failure ("unknown transport type: " ^ name))
+
+let of_addresses ?switch ?(capabilities=OBus_auth.capabilities) ?mechanisms addresses =
+  Lwt_switch.check switch;
+  match addresses with
+    | [] ->
+        Lwt.fail (Invalid_argument "OBus_transport.of_addresses: no address given")
+    | addr :: rest ->
+        (* Search an address for which connection succeed: *)
+        let%lwt fd, domain =
+          try%lwt
+            connect addr
+          with exn ->
+            (* If the first try fails, try with the others: *)
+            let rec find = function
+              | [] ->
+                  (* If they all fail, raise the first exception: *)
+                  Lwt.fail exn
+              | addr :: rest ->
+                  try%lwt
+                    connect addr
+                  with exn ->
+                    find rest
+            in
+            find rest
+        in
+        (* Do authentication only once: *)
+        try%lwt
+          Lwt_unix.write_string fd "\x00" 0 1 >>= function
+            | 0 ->
+                Lwt.fail (OBus_auth.Auth_failure "failed to send the initial null byte")
+            | 1 ->
+                let%lwt guid, capabilities =
+                  OBus_auth.Client.authenticate
+                    ~capabilities:(List.filter (function `Unix_fd -> domain = PF_UNIX) capabilities)
+                    ?mechanisms
+                    ~stream:(OBus_auth.stream_of_fd fd)
+                    ()
+                in
+                Lwt.return (guid, socket ?switch ~capabilities fd)
+            | n ->
+                assert false
+        with exn ->
+          Lwt_unix.shutdown fd SHUTDOWN_ALL;
+          let%lwt () = Lwt_unix.close fd in
+          Lwt.fail exn
diff --git a/src/protocol/oBus_transport.mli b/src/protocol/oBus_transport.mli
new file mode 100644
index 0000000..a360b2e
--- /dev/null
+++ b/src/protocol/oBus_transport.mli
@@ -0,0 +1,79 @@
+(*
+ * oBus_transport.mli
+ * ------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Low-level transporting of messages *)
+
+type t
+  (** Type of message transport *)
+
+val recv : t -> OBus_message.t Lwt.t
+  (** [recv tr] receives one message from the given transport *)
+
+val send : t -> OBus_message.t -> unit Lwt.t
+  (** [send tr msg] sends [msg] over the transport [tr]. *)
+
+val capabilities : t -> OBus_auth.capability list
+  (** Returns the capabilities of the transport *)
+
+val shutdown : t -> unit Lwt.t
+  (** [shutdown tr] frees resources allocated by the given transport *)
+
+val make :
+  ?switch : Lwt_switch.t ->
+  recv : (unit -> OBus_message.t Lwt.t) ->
+  send : (OBus_message.t -> unit Lwt.t) ->
+  ?capabilities : OBus_auth.capability list ->
+  shutdown : (unit -> unit Lwt.t) -> unit -> t
+  (** [make ?switch ~recv ~send ~support_unxi_fd ~shutdown ()] creates
+      a new transport from the given functions. @param capabilities
+      defaults to [[]].
+
+      Notes:
+      - message reading/writing are serialized by obus, so there is no
+        need to handle concurrent access to transport
+  *)
+
+val loopback : unit -> t
+  (** Loopback transport, each message sent is received on the same
+      transport *)
+
+val socket : ?switch : Lwt_switch.t -> ?capabilities : OBus_auth.capability list ->  Lwt_unix.file_descr -> t
+  (** [socket ?switch ?capabilities socket] creates a socket
+      transport.
+
+      @param capabilities defaults to [[]]. For unix sockets, the
+      [`Unix_fd] capability is accepted. *)
+
+val of_addresses :
+  ?switch : Lwt_switch.t ->
+  ?capabilities : OBus_auth.capability list ->
+  ?mechanisms : OBus_auth.Client.mechanism list ->
+  OBus_address.t list ->
+  (OBus_address.guid * t) Lwt.t
+    (** [of_addresses ?switch ?capabilities ?mechanisms addresses] tries to:
+
+        - connect to the server using one of the given given addresses,
+        - authenticate itself to the server using [mechanisms], which
+          defaults to {!OBus_auth.Client.default_mechanisms},
+        - negotiates [capabilities], which defaults to
+          {!OBus_auth.capabilities}
+
+        If all succeeded, it returns the server address guid and the
+        newly created transport, which is ready to send and receive
+        messages.
+
+        Note about errors:
+        - if one of the addresses is not valid, or [addresses = []],
+          it raises [Invalid_argument],
+        - if all connections failed, it raises the exception raised
+          by the try on first address, which is either a [Failure] or
+          a [Unix.Unix_error]
+        - if the authentication failed, a {!OBus_auth.Auth_error} is
+          raised
+    *)
diff --git a/src/protocol/oBus_uuid.ml b/src/protocol/oBus_uuid.ml
new file mode 100644
index 0000000..c2ab26a
--- /dev/null
+++ b/src/protocol/oBus_uuid.ml
@@ -0,0 +1,28 @@
+(*
+ * oBus_uuid.ml
+ * ------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+type t = string
+
+let of_string str =
+  let fail _ = raise (Invalid_argument (Printf.sprintf "OBus_uuid.of_string(%S)" str)) in
+  if String.length str <> 32 then fail ();
+  try OBus_util.hex_decode str
+  with _ -> fail ()
+
+let to_string = OBus_util.hex_encode
+
+let generate () =
+  let uuid = Bytes.create 16 in
+  OBus_util.fill_random uuid 0 12;
+  let v = Int32.of_float (Unix.time ()) in
+  Bytes.set uuid 12 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 24)));
+  Bytes.set uuid 13 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 16)));
+  Bytes.set uuid 14 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 8)));
+  Bytes.set uuid 15 (Char.unsafe_chr (Int32.to_int v));
+  Bytes.unsafe_to_string uuid
diff --git a/src/protocol/oBus_uuid.mli b/src/protocol/oBus_uuid.mli
new file mode 100644
index 0000000..9888e88
--- /dev/null
+++ b/src/protocol/oBus_uuid.mli
@@ -0,0 +1,31 @@
+(*
+ * oBus_uuid.mli
+ * -------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** D-Bus universally-unique IDs *)
+
+(** D-Bus uuid are used to distinguish message buses, addresses, and
+    machines.
+
+    Note that they are not compatible with RFC4122. *)
+
+type t
+
+val generate : unit -> t
+  (** Generate a new uuid *)
+
+val of_string : string -> t
+  (** Create a uuid from a string. The string must contain an
+      hex-encoded uuid, i.e. be of length 32 and only contain
+      hexadecimal characters. It raise a failure otherwise.
+
+      @raise Invalid_argument if the string does not contain a valid
+      uuid. *)
+
+val to_string : t -> string
+  (** Return a hex-encoded string representation of an uuid. *)
diff --git a/src/protocol/oBus_wire.ml b/src/protocol/oBus_wire.ml
new file mode 100644
index 0000000..4a8cba5
--- /dev/null
+++ b/src/protocol/oBus_wire.ml
@@ -0,0 +1,1333 @@
+(*
+ * oBus_lowlevel.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(wire)"
+
+open Printf
+open OBus_value
+open OBus_message
+open OBus_protocol
+
+(* +-----------------------------------------------------------------+
+   | Errors                                                          |
+   +-----------------------------------------------------------------+ *)
+
+exception Data_error of string
+exception Protocol_error of string
+
+let () =
+  Printexc.register_printer
+    (function
+       | Data_error msg ->
+           Some(sprintf "failed to marshal D-Bus message: %s" msg)
+       | Protocol_error msg ->
+           Some(sprintf "D-Bus protocol error: %s" msg)
+       | _ ->
+           None)
+
+(* Common error message *)
+let array_too_big len = sprintf "array size exceed the limit: %d" len
+let message_too_big len = sprintf "message size exceed the limit: %d" len
+let signature_too_long s len = sprintf "too long signature: '%s', with len %d" (string_of_signature s) len
+let invalid_protocol_version ver = sprintf "invalid protocol version: %d (obus implement protocol version %d)" ver OBus_info.protocol_version
+let invalid_byte_order ch = sprintf "invalid byte order(%C)" ch
+
+(* +-----------------------------------------------------------------+
+   | Padding                                                         |
+   +-----------------------------------------------------------------+ *)
+
+let padding2 i = i land 1
+let padding4 i = (4 - i) land 3
+let padding8 i = (8 - i) land 7
+
+let pad2 i = i + padding2 i
+let pad4 i = i + padding4 i
+let pad8 i = i + padding8 i
+
+let pad8_p = function
+  | T.Structure _
+  | T.Basic T.Int64
+  | T.Basic T.Uint64
+  | T.Basic T.Double -> true
+  | _ -> false
+
+(* +-----------------------------------------------------------------+
+   | Raw description of header fields                                |
+   +-----------------------------------------------------------------+ *)
+
+type raw_fields = {
+  mutable rf_path : OBus_path.t option;
+  mutable rf_member : OBus_name.member;
+  mutable rf_interface : OBus_name.interface;
+  mutable rf_error_name : OBus_name.error;
+  mutable rf_reply_serial : serial option;
+  mutable rf_destination : OBus_name.bus;
+  mutable rf_sender : OBus_name.bus;
+  mutable rf_signature : signature;
+  mutable rf_unix_fds : int;
+}
+
+let missing_field message_type_name field_name =
+  raise (Protocol_error(sprintf "invalid header, field '%s' is required for '%s'"
+                          field_name message_type_name))
+
+let get_required_string message_type_name field_name = function
+  | "" ->
+      missing_field message_type_name field_name
+  | string ->
+      string
+
+let get_required_option message_type_name field_name = function
+  | None ->
+      missing_field message_type_name field_name
+  | Some value ->
+      value
+
+let method_call_of_raw fields =
+  Method_call(get_required_option "method-call" "path" fields.rf_path,
+              fields.rf_interface,
+              get_required_string "method-call" "member" fields.rf_member)
+
+let method_return_of_raw fields =
+  Method_return(get_required_option "method-return" "reply-serial" fields.rf_reply_serial)
+
+let error_of_raw fields =
+  Error(get_required_option "error" "reply-serial" fields.rf_reply_serial,
+        get_required_string "error" "error-name" fields.rf_error_name)
+
+let signal_of_raw fields =
+  Signal(get_required_option "signal" "path" fields.rf_path,
+         get_required_string "signal" "interface" fields.rf_interface,
+         get_required_string "signal" "member" fields.rf_member)
+
+(* +-----------------------------------------------------------------+
+   | Error mapping                                                   |
+   +-----------------------------------------------------------------+ *)
+
+(* Maps error returned by [OBus_*.*] to [Data_error] or
+   [Protocol_error]: *)
+
+let map_exn f = function
+  | OBus_string.Invalid_string err ->
+      raise (f (OBus_string.error_message err))
+  | OBus_value.Invalid_signature(str, msg) ->
+      raise (f (Printf.sprintf "invalid signature (%S): %s" str msg))
+  | exn ->
+      raise exn
+
+let data_error msg = Data_error msg
+let protocol_error msg = Protocol_error msg
+
+(* +-----------------------------------------------------------------+
+   | Message size calculation                                        |
+   +-----------------------------------------------------------------+ *)
+
+module FD_set = Set.Make(struct type t = Unix.file_descr let compare = compare end)
+
+module Count =
+struct
+  (* The goal of this module is to compute the marshaled size of a
+     message, and the number of different file descriptors it
+     contains. *)
+
+  type counter = {
+    mutable ofs : int;
+    (* Simulate an offset *)
+    mutable fds : FD_set.t;
+    (* Set used to collect all file descriptors *)
+  }
+
+  let path_length = function
+    | [] -> 1
+    | l -> List.fold_left (fun acc x -> 1 + String.length x + acc) 0 l
+
+  let rec iter f c = function
+    | [] -> ()
+    | x :: l -> f c x; iter f c l
+
+  let rec tsingle c = function
+    | T.Basic _ ->
+        c.ofs <- c.ofs + 1
+    | T.Array t ->
+        c.ofs <- c.ofs + 1;
+        tsingle c t
+    | T.Dict(tk, tv) ->
+        c.ofs <- c.ofs + 4;
+        tsingle c tv
+    | T.Structure l ->
+        c.ofs <- c.ofs + 2;
+        iter tsingle c l
+    | T.Variant ->
+        c.ofs <- c.ofs + 1
+
+  let tsequence c l =
+    iter tsingle c l
+
+  let rec tsingle_of_single c = function
+    | V.Basic x ->
+        c.ofs <- c.ofs + 1
+    | V.Array(t, x) ->
+        c.ofs <- c.ofs + 1;
+        tsingle c t
+    | V.Byte_array _ ->
+        c.ofs <- c.ofs + 2
+    | V.Dict(tk, tv, x) ->
+        c.ofs <- c.ofs + 4;
+        tsingle c tv
+    | V.Structure l ->
+        c.ofs <- c.ofs + 2;
+        iter tsingle_of_single c l
+    | V.Variant x ->
+        c.ofs <- c.ofs + 1
+
+  let tsequence_of_sequence c l =
+    iter tsingle_of_single c l
+
+  let rec basic c = function
+    | V.Byte _ ->
+        c.ofs <- c.ofs + 1
+    | V.Int16 _
+    | V.Uint16 _ ->
+        c.ofs <- pad2 c.ofs + 2
+    | V.Boolean _
+    | V.Int32 _
+    | V.Uint32 _ ->
+        c.ofs <- pad4 c.ofs + 4
+    | V.Int64 _
+    | V.Uint64 _
+    | V.Double _ ->
+        c.ofs <- pad8 c.ofs + 8
+    | V.String s ->
+        c.ofs <- pad4 c.ofs + String.length s + 5
+    | V.Signature s ->
+        c.ofs <- c.ofs + 2;
+        tsequence c s
+    | V.Object_path p ->
+        c.ofs <- pad4 c.ofs + path_length p + 5
+    | V.Unix_fd fd ->
+        c.ofs <- pad4 c.ofs + 4;
+        c.fds <- FD_set.add fd c.fds
+
+  let rec single c = function
+    | V.Basic x ->
+        basic c x
+    | V.Array(t, l) ->
+        c.ofs <- pad4 c.ofs + 4;
+        if pad8_p t then c.ofs <- pad8 c.ofs;
+        iter single c l
+    | V.Byte_array bytes ->
+        c.ofs <- pad4 c.ofs + 4 + String.length bytes
+    | V.Dict(tk, tv, l) ->
+        c.ofs <- pad8 (pad4 c.ofs + 4);
+        iter dict_entry c l
+    | V.Structure l ->
+        c.ofs <- pad8 c.ofs;
+        iter single c l
+    | V.Variant x ->
+        c.ofs <- c.ofs + 2;
+        tsingle_of_single c x;
+        single c x
+
+  and dict_entry c (k, v) =
+    c.ofs <- pad8 c.ofs;
+    basic c k;
+    single c v
+
+  let sequence c l =
+    iter single c l
+
+  let message msg =
+    let c = { ofs = 16; fds = FD_set.empty } in
+    begin match msg.typ with
+      | Method_call(path, "", member) ->
+          (* +9 for:
+             - the code (1)
+             - the signature of one basic type code (3)
+             - the string length (4)
+             - the null byte (1) *)
+          c.ofs <- pad8 c.ofs + 9 + path_length path;
+          c.ofs <- pad8 c.ofs + 9 + String.length member
+      | Method_call(path, interface, member)
+      | Signal(path, interface, member) ->
+          c.ofs <- pad8 c.ofs + 9 + path_length path;
+          c.ofs <- pad8 c.ofs + 9 + String.length interface;
+          c.ofs <- pad8 c.ofs + 9 + String.length member
+      | Method_return serial ->
+          c.ofs <- pad8 c.ofs + 8
+      | Error(serial, name) ->
+          c.ofs <- pad8 c.ofs + 9 + String.length name;
+          c.ofs <- pad8 c.ofs + 8
+    end;
+    if msg.destination <> "" then
+      c.ofs <- pad8 c.ofs + 9 + String.length msg.destination;
+    if msg.sender <> "" then
+      c.ofs <- pad8 c.ofs + 9 + String.length msg.sender;
+    (* The signature *)
+    c.ofs <- pad8 c.ofs + 6;
+    tsequence_of_sequence c msg.body;
+    (* The number of fds: *)
+    c.ofs <- pad8 c.ofs + 8;
+    (* The message body: *)
+    sequence c msg.body;
+    c
+end
+
+(* +-----------------------------------------------------------------+
+   | Unsafe writing of integers                                      |
+   +-----------------------------------------------------------------+ *)
+
+let put_char = Bytes.unsafe_set
+let put_uint8 buf ofs x = put_char buf ofs (Char.unsafe_chr x)
+
+module type Integer_writers = sig
+  val put_int16 : bytes -> int -> int -> unit
+  val put_int32 : bytes -> int -> int32 -> unit
+  val put_int64 : bytes -> int -> int64 -> unit
+  val put_uint16 : bytes -> int -> int -> unit
+  val put_uint32 : bytes -> int -> int32 -> unit
+  val put_uint64 : bytes -> int -> int64 -> unit
+
+  val put_uint : bytes -> int -> int -> unit
+end
+
+module LE_integer_writers : Integer_writers =
+struct
+  let put_int16 buf ofs v =
+    put_uint8 buf (ofs + 0) v;
+    put_uint8 buf (ofs + 1) (v lsr 8)
+  let put_uint16 = put_int16
+
+  let put_int32 buf ofs v =
+    put_uint8 buf (ofs + 0) (Int32.to_int v);
+    put_uint8 buf (ofs + 1) (Int32.to_int (Int32.shift_right v 8));
+    put_uint8 buf (ofs + 2) (Int32.to_int (Int32.shift_right v 16));
+    put_uint8 buf (ofs + 3) (Int32.to_int (Int32.shift_right v 24))
+  let put_uint32 = put_int32
+
+  let put_int64 buf ofs v =
+    put_uint8 buf (ofs + 0) (Int64.to_int v);
+    put_uint8 buf (ofs + 1) (Int64.to_int (Int64.shift_right v 8));
+    put_uint8 buf (ofs + 2) (Int64.to_int (Int64.shift_right v 16));
+    put_uint8 buf (ofs + 3) (Int64.to_int (Int64.shift_right v 24));
+    put_uint8 buf (ofs + 4) (Int64.to_int (Int64.shift_right v 32));
+    put_uint8 buf (ofs + 5) (Int64.to_int (Int64.shift_right v 40));
+    put_uint8 buf (ofs + 6) (Int64.to_int (Int64.shift_right v 48));
+    put_uint8 buf (ofs + 7) (Int64.to_int (Int64.shift_right v 56))
+  let put_uint64 = put_int64
+
+  let put_uint buf ofs v =
+    put_uint8 buf (ofs + 0) v;
+    put_uint8 buf (ofs + 1) (v lsr 8);
+    put_uint8 buf (ofs + 2) (v lsr 16);
+    put_uint8 buf (ofs + 3) (v asr 24)
+end
+
+module BE_integer_writers : Integer_writers =
+struct
+  let put_int16 buf ofs v =
+    put_uint8 buf (ofs + 0) (v lsr 8);
+    put_uint8 buf (ofs + 1) v
+  let put_uint16 = put_int16
+
+  let put_int32 buf ofs v =
+    put_uint8 buf (ofs + 0) (Int32.to_int (Int32.shift_right v 24));
+    put_uint8 buf (ofs + 1) (Int32.to_int (Int32.shift_right v 16));
+    put_uint8 buf (ofs + 2) (Int32.to_int (Int32.shift_right v 8));
+    put_uint8 buf (ofs + 3) (Int32.to_int v)
+  let put_uint32 = put_int32
+
+  let put_int64 buf ofs v =
+    put_uint8 buf (ofs + 0) (Int64.to_int (Int64.shift_right v 56));
+    put_uint8 buf (ofs + 1) (Int64.to_int (Int64.shift_right v 48));
+    put_uint8 buf (ofs + 2) (Int64.to_int (Int64.shift_right v 40));
+    put_uint8 buf (ofs + 3) (Int64.to_int (Int64.shift_right v 32));
+    put_uint8 buf (ofs + 4) (Int64.to_int (Int64.shift_right v 24));
+    put_uint8 buf (ofs + 5) (Int64.to_int (Int64.shift_right v 16));
+    put_uint8 buf (ofs + 6) (Int64.to_int (Int64.shift_right v 8));
+    put_uint8 buf (ofs + 7) (Int64.to_int v)
+  let put_uint64 = put_int64
+
+  let put_uint buf ofs v =
+    put_uint8 buf (ofs + 0) (v asr 24);
+    put_uint8 buf (ofs + 1) (v lsr 16);
+    put_uint8 buf (ofs + 2) (v lsr 8);
+    put_uint8 buf (ofs + 3) v
+end
+
+(* +-----------------------------------------------------------------+
+   | Unsafe reading of integers                                      |
+   +-----------------------------------------------------------------+ *)
+
+let get_char = String.unsafe_get
+let get_uint8 buf ofs = Char.code (get_char buf ofs)
+
+module type Integer_readers = sig
+  val get_int16 : string -> int -> int
+  val get_int32 : string -> int -> int32
+  val get_int64 : string -> int -> int64
+  val get_uint16 : string -> int -> int
+  val get_uint32 : string -> int -> int32
+  val get_uint64 : string -> int -> int64
+
+  val get_uint : string -> int -> int
+end
+
+module LE_integer_readers : Integer_readers =
+struct
+  let get_int16 buf ofs =
+    let v0 = get_uint8 buf (ofs + 0)
+    and v1 = get_uint8 buf (ofs + 1) in
+    let v = v0 lor (v1 lsl 8) in
+    if v land (1 lsl 15) = 0 then
+      v
+    else
+      ((-1 land (lnot 0x7fff)) lor v)
+
+  let get_uint16 buf ofs =
+    let v0 = get_uint8 buf (ofs + 0)
+    and v1 = get_uint8 buf (ofs + 1) in
+    (v0 lor (v1 lsl 8))
+
+  let get_int32 buf ofs =
+    let v0 = get_uint8 buf (ofs + 0)
+    and v1 = get_uint8 buf (ofs + 1)
+    and v2 = get_uint8 buf (ofs + 2)
+    and v3 = get_uint8 buf (ofs + 3) in
+    (Int32.logor
+       (Int32.logor
+          (Int32.of_int v0)
+          (Int32.shift_left (Int32.of_int v1) 8))
+       (Int32.logor
+          (Int32.shift_left (Int32.of_int v2) 16)
+          (Int32.shift_left (Int32.of_int v3) 24)))
+  let get_uint32 = get_int32
+
+  let get_int64 buf ofs =
+    let v0 = get_uint8 buf (ofs + 0)
+    and v1 = get_uint8 buf (ofs + 1)
+    and v2 = get_uint8 buf (ofs + 2)
+    and v3 = get_uint8 buf (ofs + 3)
+    and v4 = get_uint8 buf (ofs + 4)
+    and v5 = get_uint8 buf (ofs + 5)
+    and v6 = get_uint8 buf (ofs + 6)
+    and v7 = get_uint8 buf (ofs + 7) in
+    (Int64.logor
+       (Int64.logor
+          (Int64.logor
+             (Int64.of_int v0)
+             (Int64.shift_left (Int64.of_int v1) 8))
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v2) 16)
+             (Int64.shift_left (Int64.of_int v3) 24)))
+       (Int64.logor
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v4) 32)
+             (Int64.shift_left (Int64.of_int v5) 40))
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v6) 48)
+             (Int64.shift_left (Int64.of_int v7) 56))))
+  let get_uint64 = get_int64
+
+  let get_uint buf ofs =
+    let v0 = get_uint8 buf (ofs + 0)
+    and v1 = get_uint8 buf (ofs + 1)
+    and v2 = get_uint8 buf (ofs + 2)
+    and v3 = get_uint8 buf (ofs + 3) in
+    (v0 lor (v1 lsl 8) lor (v2 lsl 16) lor (v3 lsl 24))
+end
+
+module BE_integer_readers : Integer_readers =
+struct
+  let get_int16 buf ofs =
+    let v1 = get_uint8 buf (ofs + 0)
+    and v0 = get_uint8 buf (ofs + 1) in
+    let v = v0 lor (v1 lsl 8) in
+    if v land (1 lsl 15) = 0 then
+      v
+    else
+      ((-1 land (lnot 0x7fff)) lor v)
+
+  let get_uint16 buf ofs =
+    let v1 = get_uint8 buf (ofs + 0)
+    and v0 = get_uint8 buf (ofs + 1) in
+    (v0 lor (v1 lsl 8))
+
+  let get_int32 buf ofs =
+    let v3 = get_uint8 buf (ofs + 0)
+    and v2 = get_uint8 buf (ofs + 1)
+    and v1 = get_uint8 buf (ofs + 2)
+    and v0 = get_uint8 buf (ofs + 3) in
+    (Int32.logor
+       (Int32.logor
+          (Int32.of_int v0)
+          (Int32.shift_left (Int32.of_int v1) 8))
+       (Int32.logor
+          (Int32.shift_left (Int32.of_int v2) 16)
+          (Int32.shift_left (Int32.of_int v3) 24)))
+  let get_uint32 = get_int32
+
+  let get_int64 buf ofs =
+    let v7 = get_uint8 buf (ofs + 0)
+    and v6 = get_uint8 buf (ofs + 1)
+    and v5 = get_uint8 buf (ofs + 2)
+    and v4 = get_uint8 buf (ofs + 3)
+    and v3 = get_uint8 buf (ofs + 4)
+    and v2 = get_uint8 buf (ofs + 5)
+    and v1 = get_uint8 buf (ofs + 6)
+    and v0 = get_uint8 buf (ofs + 7) in
+    (Int64.logor
+       (Int64.logor
+          (Int64.logor
+             (Int64.of_int v0)
+             (Int64.shift_left (Int64.of_int v1) 8))
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v2) 16)
+             (Int64.shift_left (Int64.of_int v3) 24)))
+       (Int64.logor
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v4) 32)
+             (Int64.shift_left (Int64.of_int v5) 40))
+          (Int64.logor
+             (Int64.shift_left (Int64.of_int v6) 48)
+             (Int64.shift_left (Int64.of_int v7) 56))))
+  let get_uint64 = get_int64
+
+  let get_uint buf ofs =
+    let v3 = get_uint8 buf (ofs + 0)
+    and v2 = get_uint8 buf (ofs + 1)
+    and v1 = get_uint8 buf (ofs + 2)
+    and v0 = get_uint8 buf (ofs + 3) in
+    (v0 lor (v1 lsl 8) lor (v2 lsl 16) lor (v3 lsl 24))
+end
+
+(* +---------------------------------------------------------------+
+   | Common writing functions                                      |
+   +---------------------------------------------------------------+ *)
+
+module FD_map = Map.Make(struct type t = Unix.file_descr let compare = Pervasives.compare end)
+
+(* A pointer for serializing data *)
+type wpointer = {
+  buf : bytes;
+  mutable ofs : int;
+  max : int;
+  fds : int FD_map.t;
+  (* Maps file descriptros to their index in the resulting fds
+     array *)
+}
+
+let write_padding2 ptr =
+  if ptr.ofs land 1 = 1 then begin
+    put_uint8 ptr.buf ptr.ofs 0;
+    ptr.ofs <- ptr.ofs + 1
+  end
+
+let write_padding4 ptr =
+  for k = 1 to padding4 ptr.ofs do
+    put_uint8 ptr.buf ptr.ofs 0;
+    ptr.ofs <- ptr.ofs + 1
+  done
+
+let write_padding8 ptr =
+  for k = 1 to padding8 ptr.ofs do
+    put_uint8 ptr.buf ptr.ofs 0;
+    ptr.ofs <- ptr.ofs + 1
+  done
+
+let write1 writer ptr value =
+  writer ptr.buf ptr.ofs value;
+  ptr.ofs <- ptr.ofs + 1
+
+let write2 writer ptr value =
+  write_padding2 ptr;
+  writer ptr.buf ptr.ofs value;
+  ptr.ofs <- ptr.ofs + 2
+
+let write4 writer ptr value =
+  write_padding4 ptr;
+  writer ptr.buf ptr.ofs value;
+  ptr.ofs <- ptr.ofs + 4
+
+let write8 writer ptr value =
+  write_padding8 ptr;
+  writer ptr.buf ptr.ofs value;
+  ptr.ofs <- ptr.ofs + 8
+
+let write_bytes ptr value =
+  let len = String.length value in
+  String.unsafe_blit value 0 ptr.buf ptr.ofs len;
+  ptr.ofs <- ptr.ofs + len
+
+(* +-----------------------------------------------------------------+
+   | Message writing                                                 |
+   +-----------------------------------------------------------------+ *)
+
+module Make_writer(Integer_writers : Integer_writers) =
+struct
+  open Integer_writers
+
+  let write_uint8 ptr value = write1 put_uint8 ptr value
+  let write_uint ptr value = write4 put_uint ptr value
+
+  (* Serialize one string, without verifying it *)
+  let write_string_no_check ptr string =
+    write_uint ptr (String.length string);
+    write_bytes ptr string;
+    write_uint8 ptr 0
+
+  (* Serialize a signature. *)
+  let write_signature ptr signature =
+    let string = OBus_value.string_of_signature signature in
+    write_uint8 ptr (String.length string);
+    write_bytes ptr string;
+    write_uint8 ptr 0
+
+  let write_object_path ptr path =
+    write_string_no_check ptr (OBus_path.to_string path)
+
+  let write_basic ptr = function
+    | V.Byte x -> write1 put_char ptr x
+    | V.Boolean x -> write4 put_uint ptr (match x with true -> 1 | false -> 0)
+    | V.Int16 x -> write2 put_int16 ptr x
+    | V.Int32 x -> write4 put_int32 ptr x
+    | V.Int64 x -> write8 put_int64 ptr x
+    | V.Uint16 x -> write2 put_uint16 ptr x
+    | V.Uint32 x -> write4 put_uint32 ptr x
+    | V.Uint64 x -> write8 put_uint64 ptr x
+    | V.Double x -> write8 put_uint64 ptr (Int64.bits_of_float x)
+    | V.String x -> begin match OBus_string.validate x with
+        | Some error ->
+            raise (Data_error(OBus_string.error_message error))
+        | None ->
+            write_string_no_check ptr x
+      end
+    | V.Signature x -> write_signature ptr x
+    | V.Object_path x -> write_object_path ptr x
+    | V.Unix_fd fd -> write4 put_uint ptr (FD_map.find fd ptr.fds)
+
+  let rec write_array ptr padded_on_8 write_element values =
+    (* Array are serialized as follow:
+
+       (1) padding to a 4-block alignement (for array size)
+       (2) array size
+       (3) alignement to array elements padding (even if the array is empty)
+       (4) serialized elements
+
+       The array size (2) is the size of serialized elements (4) *)
+
+    (* Write the padding *)
+    write_padding4 ptr;
+    (* Save the position where to write the length of the array: *)
+    let length_ofs = ptr.ofs in
+    (* Allocate 4 bytes for the length: *)
+    ptr.ofs <- ptr.ofs + 4;
+    (* After the size we are always padded on 4, so we only need to
+       add padding if elements padding is 8: *)
+    if padded_on_8 then write_padding8 ptr;
+    (* Save the position of the beginning of the elements of the
+       array: *)
+    let start_ofs = ptr.ofs in
+    List.iter (fun x -> write_element ptr x) values;
+    let length = ptr.ofs - start_ofs in
+    if length < 0 || length > max_array_size then raise (Data_error(array_too_big length));
+    (* Write the array length: *)
+    put_uint ptr.buf length_ofs length
+
+  let rec write_dict_entry ptr (k, v) =
+    (* Dict-entries are serialized as follow:
+
+       (1) alignement on a 8-block
+       (2) serialized key
+       (3) serialized value *)
+    write_padding8 ptr;
+    write_basic ptr k;
+    write_single ptr v
+
+  and write_single ptr = function
+    | V.Basic x ->
+        write_basic ptr x
+    | V.Array(t, x) ->
+        write_array ptr (pad8_p t) write_single x
+    | V.Byte_array s ->
+        write_uint ptr (String.length s);
+        write_bytes ptr s
+    | V.Dict(tk, tv, x) ->
+        write_array ptr true write_dict_entry x
+    | V.Structure x ->
+        (* Structure are serialized as follow:
+
+           (1) alignement to an 8-block
+           (2) serialized contents *)
+        write_padding8 ptr;
+        write_sequence ptr x
+    | V.Variant x ->
+        (* Variant are serialized as follow:
+
+           (1) marshaled variant signature
+           (2) serialized contents *)
+        write_signature ptr [OBus_value.V.type_of_single x];
+        write_single ptr x
+
+  and write_sequence ptr = function
+    | [] ->
+        ()
+    | x :: l ->
+        write_single ptr x;
+        write_sequence ptr l
+
+  (* Header field ptr *)
+  let write_field_real ptr code typ writer value =
+    (* Each header field is a structure, so we need to be aligned on 8 *)
+    write_padding8 ptr;
+    write_uint8 ptr code;
+    write_signature ptr [T.Basic typ];
+    writer ptr value
+
+  (* Write a field if defined *)
+  let write_field ptr code typ writer = function
+    | None ->
+        ()
+    | Some value ->
+        write_field_real ptr code typ writer value
+
+  (* Validate and write a field if defined *)
+  let write_name_field ptr code test = function
+    | "" ->
+        ()
+    | string ->
+        match test string with
+          | Some error ->
+              raise (Data_error(OBus_string.error_message error))
+          | None ->
+              write_field_real ptr code T.String write_string_no_check string
+
+  (* Serialize one complete message *)
+  let write_message byte_order_char msg =
+    let { Count.ofs = size; Count.fds = fds } = Count.message msg in
+    if size > max_message_size then raise (Data_error(message_too_big size));
+
+    let buffer = Bytes.create size in
+    let ptr = {
+      buf = buffer;
+      ofs = 16;
+      max = size;
+      fds = snd (FD_set.fold (fun fd (n, map) -> (n + 1, FD_map.add fd n map)) fds (0, FD_map.empty));
+    } in
+
+    let fd_count = FD_set.cardinal fds in
+    (* Compute ``raw'' headers *)
+    let code, fields = match msg.typ with
+      | Method_call(path, interface, member) ->
+          if member = "" then raise (Data_error "invalid method-call message: field 'member' is empty");
+          (1,
+           { rf_path = Some path;
+             rf_interface = interface;
+             rf_member = member;
+             rf_error_name = "";
+             rf_reply_serial = None;
+             rf_destination = msg.destination;
+             rf_sender = msg.sender;
+             rf_signature = V.type_of_sequence msg.body;
+             rf_unix_fds = fd_count })
+      | Method_return reply_serial ->
+          (2,
+           { rf_path = None;
+             rf_interface = "";
+             rf_member = "";
+             rf_error_name = "";
+             rf_reply_serial = Some reply_serial;
+             rf_destination = msg.destination;
+             rf_sender = msg.sender;
+             rf_signature = V.type_of_sequence msg.body;
+             rf_unix_fds = fd_count })
+      | Error(reply_serial, error_name) ->
+          if error_name = "" then raise (Data_error "invalid error message: field 'error-name' is empty");
+          (3,
+           { rf_path = None;
+             rf_interface = "";
+             rf_member = "";
+             rf_error_name = error_name;
+             rf_reply_serial = Some reply_serial;
+             rf_destination = msg.destination;
+             rf_sender = msg.sender;
+             rf_signature = V.type_of_sequence msg.body;
+             rf_unix_fds = fd_count })
+      | Signal(path, interface, member) ->
+          if interface = "" then raise (Data_error "invalid signal message, field 'interface' is empty");
+          if member = "" then raise (Data_error "invalid signal message, field 'member' is empty");
+          (4,
+           { rf_path = Some path;
+             rf_interface = interface;
+             rf_member = member;
+             rf_error_name = "";
+             rf_reply_serial = None;
+             rf_destination = msg.destination;
+             rf_sender = msg.sender;
+             rf_signature = V.type_of_sequence msg.body;
+             rf_unix_fds = fd_count })
+    in
+
+    write_field ptr 1 T.Object_path write_object_path fields.rf_path;
+    write_name_field ptr 2 OBus_name.validate_interface fields.rf_interface;
+    write_name_field ptr 3 OBus_name.validate_member fields.rf_member;
+    write_name_field ptr 4 OBus_name.validate_error fields.rf_error_name;
+    write_field ptr 5 T.Uint32 (write4 put_uint32) fields.rf_reply_serial;
+    write_name_field ptr 6 OBus_name.validate_bus fields.rf_destination;
+    write_name_field ptr 7 OBus_name.validate_bus fields.rf_sender;
+    write_field_real ptr 8 T.Signature write_signature fields.rf_signature;
+    write_field_real ptr 9 T.Uint32 (write4 put_uint) fields.rf_unix_fds;
+
+    let fields_length = ptr.ofs - 16 in
+
+    if fields_length < 0 || fields_length > max_array_size then
+      raise (Data_error(array_too_big fields_length));
+
+    (* The message body start aligned on an 8-boundary after the
+       header: *)
+    write_padding8 ptr;
+
+    let start_ofs = ptr.ofs in
+
+    (* Write the message body *)
+    write_sequence ptr msg.body;
+
+    let body_length = ptr.ofs - start_ofs in
+
+    (* byte #0 : byte-order *)
+    put_char buffer 0 byte_order_char;
+    (* byte #1 : message type code *)
+    put_uint8 buffer 1 code;
+    (* byte #2 : message flags *)
+    put_uint8 buffer 2
+      ((if msg.flags.no_reply_expected then 1 else 0) lor
+         (if msg.flags.no_auto_start then 2 else 0));
+    (* byte #3 : protocol version *)
+    put_uint8 buffer 3 OBus_info.protocol_version;
+    (* byte #4-7 : body length *)
+    put_uint buffer 4 body_length;
+    (* byte #8-11 : serial *)
+    put_uint32 buffer 8 msg.serial;
+    (* byte #12-15 : fields length *)
+    put_uint buffer 12 fields_length;
+
+    (* Create the array of file descriptors *)
+    let fds = Array.make fd_count Unix.stdin in
+    FD_map.iter (fun fd index -> Array.unsafe_set fds index fd) ptr.fds;
+
+    (Bytes.unsafe_to_string ptr.buf, fds)
+end
+
+module LE_writer = Make_writer(LE_integer_writers)
+module BE_writer = Make_writer(BE_integer_writers)
+
+let string_of_message ?(byte_order=Lwt_io.system_byte_order) msg =
+  try
+    match byte_order with
+      | Lwt_io.Little_endian ->
+          LE_writer.write_message 'l' msg
+      | Lwt_io.Big_endian ->
+          BE_writer.write_message 'B' msg
+  with exn ->
+    raise (map_exn data_error exn)
+
+let write_message oc ?byte_order msg =
+  match string_of_message ?byte_order msg with
+    | str, [||] ->
+        Lwt_io.write oc str
+    | _ ->
+        Lwt.fail (Data_error "Cannot send a message with file descriptors on a channel")
+
+type writer = {
+  w_channel : Lwt_io.output_channel;
+  w_file_descr : Lwt_unix.file_descr;
+}
+
+let close_writer writer = Lwt_io.close writer.w_channel
+
+let writer fd = {
+  w_channel = Lwt_io.of_fd ~mode:Lwt_io.output ~close:Lwt.return fd;
+  w_file_descr = fd;
+}
+
+let write_message_with_fds writer ?byte_order msg =
+  match string_of_message ?byte_order msg with
+    | buf, [||] ->
+        (* No file descriptor to send, simply use the channel *)
+        Lwt_io.write writer.w_channel buf
+    | buf, fds ->
+        Lwt_io.atomic begin fun oc ->
+          (* Ensures there is nothing left to send: *)
+          let%lwt () = Lwt_io.flush oc in
+          let len = String.length buf in
+          let vec = Lwt_unix.IO_vectors.create () in
+          Lwt_unix.IO_vectors.append_bytes vec (Bytes.unsafe_of_string buf) 0 len;
+          (* Send the file descriptors and the message: *)
+          let%lwt n = Lwt_unix.Versioned.send_msg_2 writer.w_file_descr vec (Array.to_list fds) in
+          assert (n >= 0 && n <= len);
+          (* Write what is remaining: *)
+          Lwt_io.write_from_string_exactly oc buf n (len - n)
+        end writer.w_channel
+
+(* +-----------------------------------------------------------------+
+   | Common reading operations                                       |
+   +-----------------------------------------------------------------+ *)
+
+(* A pointer for unserializing data *)
+type rpointer = {
+  buf : string;
+  mutable ofs : int;
+  max : int;
+  mutable fds : Unix.file_descr array;
+  (* The array of file descriptors received with the message *)
+}
+
+let out_of_bounds () = raise (Protocol_error "out of bounds")
+let unitialized_padding () = raise (Protocol_error "unitialized padding")
+
+let read_padding ptr count =
+  for i = 1 to count do
+    if get_uint8 ptr.buf ptr.ofs <> 0 then unitialized_padding ();
+    ptr.ofs <- ptr.ofs + 1
+  done
+
+let read_padding2 ptr =
+  if padding2 ptr.ofs = 1 then begin
+    if ptr.ofs + 1 > ptr.max then out_of_bounds ();
+    if get_uint8 ptr.buf ptr.ofs <> 0 then unitialized_padding ()
+  end
+
+let read_padding4 ptr =
+  let padding = padding4 ptr.ofs in
+  if ptr.ofs + padding > ptr.max then out_of_bounds ();
+  read_padding ptr padding
+
+let read_padding8 ptr =
+  let padding = padding8 ptr.ofs in
+  if ptr.ofs + padding > ptr.max then out_of_bounds ();
+  read_padding ptr padding
+
+let read1 reader ptr =
+  if ptr.ofs + 1 > ptr.max then out_of_bounds ();
+  let x = reader ptr.buf ptr.ofs in
+  ptr.ofs <- ptr.ofs + 1;
+  x
+
+let read2 reader ptr =
+  let padding = padding2 ptr.ofs in
+  if ptr.ofs + padding + 2 > ptr.max then out_of_bounds ();
+  read_padding ptr padding;
+  let x = reader ptr.buf ptr.ofs in
+  ptr.ofs <- ptr.ofs + 2;
+  x
+
+let read4 reader ptr =
+  let padding = padding4 ptr.ofs in
+  if ptr.ofs + padding + 4 > ptr.max then out_of_bounds ();
+  read_padding ptr padding;
+  let x = reader ptr.buf ptr.ofs in
+  ptr.ofs <- ptr.ofs + 4;
+  x
+
+let read8 reader ptr =
+  let padding = padding8 ptr.ofs in
+  if ptr.ofs + padding + 8 > ptr.max then out_of_bounds ();
+  read_padding ptr padding;
+  let x = reader ptr.buf ptr.ofs in
+  ptr.ofs <- ptr.ofs + 8;
+  x
+
+let read_bytes ptr len =
+  if len < 0 || ptr.ofs + len > ptr.max then out_of_bounds ();
+  let s = Bytes.create len in
+  String.unsafe_blit ptr.buf ptr.ofs s 0 len;
+  ptr.ofs <- ptr.ofs + len;
+  Bytes.unsafe_to_string s
+
+(* +-----------------------------------------------------------------+
+   | Message reading                                                 |
+   +-----------------------------------------------------------------+ *)
+
+module Make_reader(Integer_readers : Integer_readers) =
+struct
+  open Integer_readers
+
+  let read_uint ptr = read4 get_uint ptr
+  let read_uint8 ptr = read1 get_uint8 ptr
+
+  let read_string_no_check ptr =
+    let len = read_uint ptr in
+    let x = read_bytes ptr len in
+    if read_uint8 ptr <> 0 then raise (Protocol_error "missing string terminal null byte");
+    x
+
+  let read_signature ptr =
+    let len = read_uint8 ptr in
+    let x = read_bytes ptr len in
+    if read_uint8 ptr <> 0 then raise (Protocol_error "missing signature terminating null byte");
+    OBus_value.signature_of_string x
+
+  let read_object_path ptr =
+    let str = read_string_no_check ptr in
+    OBus_path.of_string str
+
+  let read_vbyte ptr = V.Byte(read1 get_char ptr)
+  let read_vboolean ptr = match read_uint ptr with
+    | 0 -> V.Boolean false
+    | 1 -> V.Boolean true
+    | n -> raise (Protocol_error(sprintf "invalid boolean value: %d" n))
+  let read_vint16 ptr = V.Int16(read2 get_int16 ptr)
+  let read_vint32 ptr = V.Int32(read4 get_int32 ptr)
+  let read_vint64 ptr = V.Int64(read8 get_int64 ptr)
+  let read_vuint16 ptr = V.Uint16(read2 get_uint16 ptr)
+  let read_vuint32 ptr = V.Uint32(read4 get_uint32 ptr)
+  let read_vuint64 ptr = V.Uint64(read8 get_uint64 ptr)
+  let read_vdouble ptr = V.Double(Int64.float_of_bits (read8 get_uint64 ptr))
+  let read_vstring ptr =
+    let str = read_string_no_check ptr in
+    match OBus_string.validate str with
+      | None -> V.String str
+      | Some error -> raise (Protocol_error(OBus_string.error_message error))
+  let read_vsignature ptr = V.Signature(read_signature ptr)
+  let read_vobject_path ptr = V.Object_path(read_object_path ptr)
+  let read_unix_fd ptr =
+    let index = read4 get_uint ptr in
+    if index < 0 || index >= Array.length ptr.fds then
+      raise (Protocol_error "fd index out of bounds")
+    else
+      V.Unix_fd(Array.unsafe_get ptr.fds index)
+
+  let basic_reader = function
+    | T.Byte -> read_vbyte
+    | T.Boolean -> read_vboolean
+    | T.Int16 -> read_vint16
+    | T.Int32 -> read_vint32
+    | T.Int64 -> read_vint64
+    | T.Uint16 -> read_vuint16
+    | T.Uint32 -> read_vuint32
+    | T.Uint64 -> read_vuint64
+    | T.Double -> read_vdouble
+    | T.String -> read_vstring
+    | T.Signature -> read_vsignature
+    | T.Object_path -> read_vobject_path
+    | T.Unix_fd -> read_unix_fd
+
+  let read_array padded_on_8 read_element ptr =
+    let len = read_uint ptr in
+    if len < 0 || len > max_array_size then raise (Protocol_error(array_too_big len));
+    if padded_on_8 then read_padding8 ptr;
+    let limit = ptr.ofs + len in
+    let rec aux () =
+      if ptr.ofs >= limit then
+        []
+      else
+        let x = read_element ptr in
+        let l = aux () in
+        x :: l
+    in
+    aux ()
+
+  let rec single_reader = function
+    | T.Basic t ->
+        let reader = basic_reader t in
+        (fun ptr -> V.basic(reader ptr))
+    | T.Array(T.Basic T.Byte)->
+        (fun ptr ->
+           let len = read_uint ptr in
+           if len < 0 || len > max_array_size then raise (Protocol_error(array_too_big len));
+           V.byte_array (read_bytes ptr len))
+    | T.Array t ->
+        let reader = single_reader t and padded_on_8 = pad8_p t in
+        (fun ptr -> V.unsafe_array t (read_array padded_on_8 reader ptr))
+    | T.Dict(tk, tv) ->
+        let kreader = basic_reader tk and vreader = single_reader tv in
+        let reader ptr =
+          read_padding8 ptr;
+          let k = kreader ptr in
+          let v = vreader ptr in
+          (k, v)
+        in
+        (fun ptr -> V.unsafe_dict tk tv (read_array true reader ptr))
+    | T.Structure tl ->
+        let reader = sequence_reader tl in
+        (fun ptr ->
+           read_padding8 ptr;
+           V.structure (reader ptr))
+    | T.Variant ->
+        read_variant
+
+  and read_variant ptr =
+    match read_signature ptr with
+      | [t] ->
+          V.variant (single_reader t ptr)
+      | s ->
+          raise (Protocol_error(Printf.sprintf "variant signature does not contain one single type: %S" (OBus_value.string_of_signature s)))
+
+  and sequence_reader = function
+    | [] ->
+        (fun ptr -> [])
+    | t :: l ->
+        let head_reader = single_reader t and tail_reader = sequence_reader l in
+        (fun ptr ->
+           let x = head_reader ptr in
+           let l = tail_reader ptr in
+           x :: l)
+
+  let read_field code typ reader ptr =
+    match read_signature ptr with
+      | [T.Basic t] when t = typ ->
+          reader ptr
+      | s ->
+          raise (Protocol_error(sprintf "invalid header field signature for code %d: %S, should be %S"
+                                  code (string_of_signature s) (string_of_signature [T.Basic typ])))
+
+  let read_name_field code test ptr =
+    let str = read_field code T.String read_string_no_check ptr in
+    match test str with
+      | None ->
+          str
+      | Some error ->
+          raise (Protocol_error(OBus_string.error_message error))
+
+  let read_message buffer get_message =
+    (* Check the protocol version first, since we can not do anything
+       if it is not the same as our *)
+    let protocol_version = get_uint8 buffer 3 in
+    if protocol_version <> OBus_info.protocol_version then
+      raise (Protocol_error(invalid_protocol_version protocol_version));
+
+    let message_maker = match get_uint8 buffer 1 with
+      | 1 -> method_call_of_raw
+      | 2 -> method_return_of_raw
+      | 3 -> error_of_raw
+      | 4 -> signal_of_raw
+      | n -> raise (Protocol_error(sprintf "unknown message type: %d" n)) in
+
+    let n = get_uint8 buffer 2 in
+    let flags = { no_reply_expected = n land 1 = 1; no_auto_start = n land 2 = 2 } in
+
+    let body_length = get_uint buffer 4
+    and serial = get_uint32 buffer 8
+    and fields_length = get_uint buffer 12 in
+
+    (* Header fields array start on byte #16 and message start aligned
+       on a 8-boundary after it, so we have: *)
+    let total_length = 16 + pad8 fields_length + body_length in
+
+    (* Safety checkings *)
+
+    if fields_length < 0 || fields_length > max_array_size then
+      raise (Protocol_error(array_too_big fields_length));
+
+    if body_length < 0 || total_length > max_message_size then
+      raise (Protocol_error(message_too_big total_length));
+
+    get_message total_length begin fun ptr pending_fds cont ->
+      let fields = {
+        rf_path = None;
+        rf_member = "";
+        rf_interface = "";
+        rf_error_name = "";
+        rf_reply_serial = None;
+        rf_destination = "";
+        rf_sender = "";
+        rf_signature = [];
+        rf_unix_fds = 0;
+      } in
+      let limit = ptr.ofs + fields_length in
+      (* Reading of fields *)
+      while ptr.ofs < limit do
+        read_padding8 ptr;
+        match read_uint8 ptr with
+          | 1 -> fields.rf_path <- Some(read_field 1 T.Object_path read_object_path ptr)
+          | 2 -> fields.rf_interface <- read_name_field 2 OBus_name.validate_interface ptr
+          | 3 -> fields.rf_member <- read_name_field 3 OBus_name.validate_member ptr
+          | 4 -> fields.rf_error_name <- read_name_field 4 OBus_name.validate_error ptr
+          | 5 -> fields.rf_reply_serial <- Some(read_field 5 T.Uint32 (read4 get_uint32) ptr)
+          | 6 -> fields.rf_destination <- read_name_field 6 OBus_name.validate_bus ptr
+          | 7 -> fields.rf_sender <- read_name_field 7 OBus_name.validate_bus ptr
+          | 8 -> fields.rf_signature <- read_field 8 T.Signature read_signature ptr
+          | 9 -> fields.rf_unix_fds <- read_field 9 T.Uint32 (read4 get_uint) ptr
+          | _ -> ignore (read_variant ptr) (* Unsupported header field *)
+      done;
+
+      begin
+        match pending_fds with
+          | None ->
+              if fields.rf_unix_fds <> Array.length ptr.fds then
+                raise (Protocol_error(sprintf
+                                        "invalid number of file descriptor, %d expected, %d received"
+                                        fields.rf_unix_fds
+                                        (Array.length ptr.fds)));
+          | Some(consumed, queue) ->
+              ptr.fds <- Array.init fields.rf_unix_fds
+                (fun i ->
+                   if Queue.is_empty queue then
+                     raise (Protocol_error "file descriptor missing")
+                   else begin
+                     let fd = Queue.take queue in
+                     consumed := fd :: !consumed;
+                     fd
+                   end)
+      end;
+
+      read_padding8 ptr;
+      let body = sequence_reader fields.rf_signature ptr in
+
+      if ptr.ofs < ptr.max then raise (Protocol_error "junk bytes after message");
+      cont { flags = flags;
+             sender = fields.rf_sender;
+             destination = fields.rf_destination;
+             serial = serial;
+             typ = message_maker fields;
+             body = body }
+    end
+end
+
+module LE_reader = Make_reader(LE_integer_readers)
+module BE_reader = Make_reader(BE_integer_readers)
+
+let read_message ic =
+  try%lwt
+    Lwt_io.atomic begin fun ic ->
+      let buffer = Bytes.create 16 in
+      let%lwt () = Lwt_io.read_into_exactly ic buffer 0 16 in
+      let buffer = Bytes.unsafe_to_string buffer in
+      (match get_char buffer 0 with
+         | 'l' -> LE_reader.read_message
+         | 'B' -> BE_reader.read_message
+         | ch -> raise (Protocol_error(invalid_byte_order ch)))
+        buffer
+        (fun length f ->
+           let length = length - 16 in
+           let buffer = Bytes.create length in
+           let%lwt () = Lwt_io.read_into_exactly ic buffer 0 length in
+           let buffer = Bytes.unsafe_to_string buffer in
+           f { buf = buffer; ofs = 0; max = length; fds = [||] } None Lwt.return)
+    end ic
+  with exn ->
+    raise (map_exn protocol_error exn)
+
+let message_of_string buffer fds =
+  if String.length buffer < 16 then invalid_arg "OBus_wire.message_of_string: buffer too small";
+  try
+    (match get_char buffer 0 with
+       | 'l' -> LE_reader.read_message
+       | 'B' -> BE_reader.read_message
+       | ch -> raise (Protocol_error(invalid_byte_order ch)))
+      buffer
+      (fun length f ->
+         if length <> String.length buffer then raise (Protocol_error "invalid message size");
+         f { buf = buffer; ofs = 16; max = length; fds = fds } None (fun x -> x))
+  with exn ->
+    raise (map_exn protocol_error exn)
+
+type reader = {
+  r_channel : Lwt_io.input_channel;
+  r_pending_fds : Unix.file_descr Queue.t;
+  (* File descriptors received and not yet taken *)
+}
+
+let close_reader reader =
+  let fds = Queue.fold (fun fds fd -> fd :: fds) [] reader.r_pending_fds in
+  Queue.clear reader.r_pending_fds;
+  let%lwt () =
+    Lwt_list.iter_p
+      (fun fd ->
+         try
+           Lwt_unix.close (Lwt_unix.of_unix_file_descr ~set_flags:false fd)
+         with Unix.Unix_error(err, _, _) ->
+           Lwt_log.error_f ~section "cannot close file descriptor: %s" (Unix.error_message err))
+      fds
+  in
+  Lwt_io.close reader.r_channel
+
+let reader fd =
+  let pending_fds = Queue.create () in
+  {
+    r_channel = Lwt_io.make ~mode:Lwt_io.input
+      (fun buf ofs len ->
+        let%lwt n, fds = Lwt_bytes.recv_msg fd [Lwt_bytes.io_vector buf ofs len] in
+         List.iter (fun fd ->
+                      (try Unix.set_close_on_exec fd with _ -> ());
+                      Queue.push fd pending_fds) fds;
+         Lwt.return n);
+    r_pending_fds = pending_fds;
+  }
+
+let read_message_with_fds reader  =
+  let consumed_fds = ref [] in
+  try%lwt
+    Lwt_io.atomic begin fun ic ->
+      let buffer = Bytes.create 16 in
+      let%lwt () = Lwt_io.read_into_exactly ic buffer 0 16 in
+      let buffer = Bytes.unsafe_to_string buffer in
+      (match get_char buffer 0 with
+         | 'l' -> LE_reader.read_message
+         | 'B' -> BE_reader.read_message
+         | ch -> raise (Protocol_error(invalid_byte_order ch)))
+        buffer
+        (fun length f ->
+           let length = length - 16 in
+           let buffer = Bytes.create length in
+           let%lwt () = Lwt_io.read_into_exactly ic buffer 0 length in
+           let buffer = Bytes.unsafe_to_string buffer in
+           f { buf = buffer; ofs = 0; max = length; fds = [||] } (Some(consumed_fds, reader.r_pending_fds)) Lwt.return)
+    end reader.r_channel
+  with exn ->
+    let%lwt () =
+      Lwt_list.iter_p
+        (fun fd ->
+           try
+             Lwt_unix.close (Lwt_unix.of_unix_file_descr ~set_flags:false fd)
+           with Unix.Unix_error(err, _, _) ->
+             Lwt_log.error_f ~section "cannot close file descriptor: %s" (Unix.error_message err))
+        !consumed_fds
+    in
+    Lwt.fail (map_exn protocol_error exn)
+
+(* +-----------------------------------------------------------------+
+   | Size computation                                                |
+   +-----------------------------------------------------------------+ *)
+
+let get_message_size buf ofs =
+
+  let unsafe_get_uint map_ofs i =
+    let v0 = String.unsafe_get buf (map_ofs (i + 0))
+    and v1 = String.unsafe_get buf (map_ofs (i + 1))
+    and v2 = String.unsafe_get buf (map_ofs (i + 2))
+    and v3 = String.unsafe_get buf (map_ofs (i + 3)) in
+    Char.code v0 lor (Char.code v1 lsl 8) lor (Char.code v2 lsl 16) lor (Char.code v3 lsl 24)
+  in
+
+  if ofs < 0 || ofs + 16 >= String.length buf then
+    raise (Invalid_argument "OBus_wire.get_message_size")
+
+  else
+    (* Byte-order *)
+    let map_ofs = match String.unsafe_get buf ofs with
+      | 'l' -> (fun i -> i)
+      | 'B' -> (fun i -> 3 - i)
+      | ch -> raise (Protocol_error(invalid_byte_order ch))
+    in
+    let ver = Char.code (String.unsafe_get buf (ofs + 3)) in
+    if ver <> OBus_info.protocol_version then
+      raise (Protocol_error(invalid_protocol_version ver));
+
+    let body_length = unsafe_get_uint map_ofs (ofs + 8)
+    and fields_length = unsafe_get_uint map_ofs (ofs + 12) in
+
+    let total_length = 16 + fields_length + pad8 fields_length + body_length in
+
+    if fields_length < 0 || fields_length > max_array_size then
+      raise (Protocol_error(array_too_big fields_length));
+
+    if body_length < 0 || total_length > max_message_size then
+      raise (Protocol_error(message_too_big total_length));
+
+    total_length
diff --git a/src/protocol/oBus_wire.mli b/src/protocol/oBus_wire.mli
new file mode 100644
index 0000000..f217a49
--- /dev/null
+++ b/src/protocol/oBus_wire.mli
@@ -0,0 +1,74 @@
+(*
+ * oBus_lowlevel.mli
+ * -----------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Message serialization/deserialization *)
+
+exception Data_error of string
+  (** Exception raised when a message can not be sent. The parameter is an
+      error message.
+
+      Possible reasons are: the message is too big or contains arrays
+      that are too big. *)
+
+exception Protocol_error of string
+  (** Exception raised when a received message is not valid.
+
+      Possible reasons are:
+
+      - a size limit is exceeded
+      - a name/string/object-path is not valid
+      - a boolean value is other than 0 or 1
+      - ... *)
+
+val read_message : Lwt_io.input_channel -> OBus_message.t Lwt.t
+  (** [read_message ic] deserializes a message from a channel. It
+      fails if the message contains file descriptors. *)
+
+val write_message : Lwt_io.output_channel -> ?byte_order : Lwt_io.byte_order -> OBus_message.t -> unit Lwt.t
+  (** [write_message oc ?byte_order message] serializes a message to a
+      channel. It fails if the message contains file descriptors. *)
+
+val message_of_string : string -> Unix.file_descr array -> OBus_message.t
+  (** [message_of_string buf fds] returns a message from a
+      string. [fds] is used to resolv file descriptors the message may
+      contains. *)
+
+val string_of_message : ?byte_order : Lwt_io.byte_order -> OBus_message.t -> string * Unix.file_descr array
+  (** Marshal a message into a string. Returns also the list of file
+      descriptors that must be sent with the message. *)
+
+type reader
+  (** A reader which support unix fd passing *)
+
+val reader : Lwt_unix.file_descr -> reader
+  (** [reader unix_socket] creates a reader from a unix socket *)
+
+val read_message_with_fds : reader -> OBus_message.t Lwt.t
+  (** Read a message with its file descriptors from the given
+      reader *)
+
+val close_reader : reader -> unit Lwt.t
+  (** [close_reader reader] closes the given reader.
+
+      Note: this does not close the underlying file descriptor. *)
+
+type writer
+  (** A writer which support unix fd passing *)
+
+val writer : Lwt_unix.file_descr -> writer
+  (** [writer unix_socket] creates a writer from a unix socket *)
+
+val write_message_with_fds : writer -> ?byte_order : Lwt_io.byte_order -> OBus_message.t -> unit Lwt.t
+  (** Write a message with its file descriptors on the given writer *)
+
+val close_writer : writer -> unit Lwt.t
+  (** [close_writer writer] closes the given writer.
+
+      Note: this does not close the underlying file descriptor. *)
+
diff --git a/tests/dune b/tests/dune
new file mode 100644
index 0000000..8c591cd
--- /dev/null
+++ b/tests/dune
@@ -0,0 +1,11 @@
+(executable
+ (name main)
+ (modules main gen_random  progress
+  test_serialization test_validation
+  test_auth test_communication test_gc)
+ (libraries lwt obus)
+ (preprocess (pps lwt_ppx)))
+
+(alias
+ (name   runtest)
+ (action (run ./main.exe)))
diff --git a/tests/gen_random.ml b/tests/gen_random.ml
new file mode 100644
index 0000000..ea52cf5
--- /dev/null
+++ b/tests/gen_random.ml
@@ -0,0 +1,166 @@
+(*
+ * gen_random.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 OBus_value
+open OBus_message
+
+let _ = Random.self_init ()
+
+let option f =
+  if Random.bool () then
+    Some(f ())
+  else
+    None
+
+(* Generate a random non-empty string *)
+let string max_len =
+  let len = 1 + Random.int max_len in
+  let str = Bytes.create len in
+  for i = 0 to len - 1 do
+    Bytes.set str i (char_of_int (Char.code 'a' + Random.int 26))
+  done;
+  Bytes.unsafe_to_string str
+
+(* Generate an object path *)
+let path () =
+  let rec aux acc = function
+    | 0 -> acc
+    | n -> aux (string 30 :: acc) (n - 1)
+  in
+  aux [] (Random.int 10)
+
+(* Generate a valid (interface/bus/error) name *)
+let name () =
+  let rec aux acc = function
+    | 0 -> acc
+    | n -> aux (string 15 :: acc) (n - 1)
+  in
+  String.concat "." (aux [] (2 + Random.int 8))
+
+let unique_name () = ":" ^ name ()
+
+(* Generate a valid member name *)
+let member () = string 20
+
+let serial () = Random.int32 Int32.max_int
+
+let message_type () = match Random.int 4 with
+  | 0 -> Method_call(path (), name (), member ())
+  | 1 -> Method_return(serial ())
+  | 2 -> Error(serial (), name ())
+  | _ -> Signal(path (), name (), member ())
+
+let uint16 () = Random.int (1 lsl 16)
+let uint32 () = Int32.logor (Int32.shift_left (Random.int32 Int32.max_int) 1) (Random.int32 2l)
+let uint64 () = Int64.logor (Int64.shift_left (Random.int64 Int64.max_int) 1) (Random.int64 2L)
+let int16 () = uint16 () - (1 lsl 15)
+let int32 () = uint32 ()
+let int64 () = uint64 ()
+let double () = Int64.to_float (int64 ())
+
+(* In the following functions, [count] is the number of terminals
+   (basic types/values) and [deep] is the current number of containers
+   nesting *)
+
+let tbasic count deep = match Random.int 12 with
+  | 0 -> count + 1, T.Byte
+  | 1 -> count + 1, T.Boolean
+  | 2 -> count + 1, T.Int16
+  | 3 -> count + 1, T.Int32
+  | 4 -> count + 1, T.Int64
+  | 5 -> count + 1, T.Uint16
+  | 6 -> count + 1, T.Uint32
+  | 7 -> count + 1, T.Uint64
+  | 8 -> count + 1, T.Double
+  | 9 -> count + 1, T.String
+  | 10 -> count + 1, T.Signature
+  | _ -> count + 1, T.Object_path
+
+let rec tsingle count deep =
+  if deep > 3 then
+    let count, t = tbasic count deep in
+    (count, T.basic t)
+  else
+    match Random.int 5 with
+      | 0 -> let count, t = tbasic count deep in (count, T.Basic t)
+      | 1 -> let count, t = tsequence count (deep + 1) in (count, T.Structure t)
+      | 2 -> let count, t = tsingle count (deep + 1) in (count, T.Array t)
+      | 3 ->
+          let count, tk = tbasic count (deep + 1) in
+          let count, tv = tsingle count (deep + 1) in
+          (count, T.Dict(tk, tv))
+      | _ -> (count + 1, T.Variant)
+
+and tsequence count deep =
+  let rec aux count acc = function
+    | 0 -> (count, acc)
+    | n -> let count, t = tsingle count (deep + 1) in aux count (t :: acc) (n - 1)
+  in
+  if count > 30 then
+    let count, t = tbasic count deep in
+    (count, [T.Basic t])
+  else
+    aux count [] (1 + Random.int 10)
+
+let basic count deep = function
+  | T.Byte -> count + 1, V.Byte(char_of_int (Random.int 256))
+  | T.Boolean -> count + 1, V.Boolean(Random.bool ())
+  | T.Int16 -> count + 1, V.Int16(int16 ())
+  | T.Int32 -> count + 1, V.Int32(int32 ())
+  | T.Int64 -> count + 1, V.Int64(int64 ())
+  | T.Uint16 -> count + 1, V.Uint16(uint16 ())
+  | T.Uint32 -> count + 1, V.Uint32(uint32 ())
+  | T.Uint64 -> count + 1, V.Uint64(uint64 ())
+  | T.Double -> count + 1, V.Double(double ())
+  | T.String -> count + 1, V.String(string 100)
+  | T.Signature -> count + 1, V.Signature(snd (tsequence 0 0))
+  | T.Object_path -> count + 1, V.Object_path(path ())
+  | T.Unix_fd -> count + 1, V.Unix_fd Unix.stdin
+
+let rec single count deep = function
+  | T.Basic t ->
+      let count, x = basic count deep t in
+      (count, V.basic x)
+  | T.Structure tl ->
+      let count, x = sequence count (deep + 1) tl in
+      (count, V.structure x)
+  | T.Array t ->
+      let rec aux count acc = function
+        | 0 -> (count, V.array t acc)
+        | n -> let count, x = single count (deep + 1) t in aux count (x :: acc) (n - 1)
+      in
+      aux count [] (Random.int (max 1 (min 200 (1000 - count))))
+  | T.Dict(tk, tv) ->
+      let rec aux count acc = function
+        | 0 -> (count, V.dict tk tv acc)
+        | n ->
+            let count, k = basic count (deep + 1) tk in
+            let count, v = single count (deep + 1) tv in
+            aux count ((k, v) :: acc) (n - 1)
+      in
+      aux count [] (Random.int (max 1 (min 200 (1000 - count))))
+  | T.Variant ->
+      let _, t = tsingle 15 (deep + 1) in
+      let count, x = single count (deep + 1) t in
+      (count, V.variant x)
+
+and sequence count deep tl =
+  List.fold_right (fun t (count, l) ->
+                     let count, x = single count (deep + 1) t in
+                     (count, x :: l))
+    tl (count, [])
+
+let message () = {
+  flags = { no_reply_expected = Random.bool (); no_auto_start = Random.bool () };
+  serial = serial ();
+  typ = message_type ();
+  destination = name ();
+  sender = unique_name ();
+  body = snd (sequence 0 0 (snd (tsequence 0 0)));
+}
diff --git a/tests/gen_random.mli b/tests/gen_random.mli
new file mode 100644
index 0000000..9dcfa86
--- /dev/null
+++ b/tests/gen_random.mli
@@ -0,0 +1,13 @@
+(*
+ * gen_random.mli
+ * --------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Generation of random test data *)
+
+val message : unit -> OBus_message.t
+  (** Generate a random message *)
diff --git a/tests/main.ml b/tests/main.ml
new file mode 100644
index 0000000..edd960f
--- /dev/null
+++ b/tests/main.ml
@@ -0,0 +1,67 @@
+(*
+ * main.ml
+ * -------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+let tty = Unix.isatty Unix.stdout
+
+let title msg =
+  if tty then
+    Lwt_io.printf "\027[34;1m%s\r=[ \027[37;1m%s\027[34;1m ]=\n\027[0m" (String.make 80 '=') msg
+  else
+    Lwt_io.printlf "=[ %s ]=" msg
+
+let rec run_tests failures total = function
+  | [] ->
+      if tty then
+        if failures = 0 then
+          Lwt_io.printl "\027[32;1mAll tests succeeded!\027[0m"
+        else
+          Lwt_io.printlf "\027[31;1m%d of %d tests failed.\027[0m" failures total
+      else
+        if failures = 0 then
+          Lwt_io.printl "All tests succeeded!"
+        else
+          Lwt_io.printlf "%d of %d tests failed." failures total
+  | (name, test) :: rest ->
+      let%lwt () = title name in
+      begin
+        try%lwt
+          test ()
+        with exn ->
+          let%lwt () = Lwt_io.printlf "test failed with: %s" (Printexc.to_string exn) in
+          let%lwt () = Lwt_io.printl (Printexc.get_backtrace ()) in
+          return false
+      end >>= function
+        | true ->
+            let%lwt () =
+              if tty then
+                Lwt_io.print "\n\027[32;1mTest passed.\n\027[0m\n"
+              else
+                Lwt_io.print "\nTest passed.\n\n"
+            in
+            run_tests failures (total + 1) rest
+        | false ->
+            let%lwt () =
+              if tty then
+                Lwt_io.print "\n\027[31;1mTest failed.\n\027[0m\n"
+              else
+                Lwt_io.print "\nTest failed.\n\n"
+            in
+            run_tests (failures + 1) (total + 1) rest
+
+let () = Lwt_main.run begin
+  run_tests 0 0 [
+    "serialization", Test_serialization.test;
+    "string validation", Test_validation.test;
+    "authentication", Test_auth.test;
+    (*"communication", Test_communication.test;*)
+    "garbage collection", Test_gc.test;
+  ]
+end
diff --git a/tests/progress.ml b/tests/progress.ml
new file mode 100644
index 0000000..54a23d2
--- /dev/null
+++ b/tests/progress.ml
@@ -0,0 +1,40 @@
+(*
+ * progress.ml
+ * -----------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+type t = {
+  mutable current_percent : int;
+  mutable current : int;
+  prefix : string;
+  max : int;
+}
+
+let make prefix max =
+  let%lwt () = Lwt_io.printf "%s: 0%%%!" prefix in
+  return {
+    prefix = prefix;
+    max = max;
+    current = 0;
+    current_percent = 0;
+  }
+
+let incr p =
+  p.current <- p.current + 1;
+  let x = p.current * 100 / p.max in
+  if x <> p.current_percent then begin
+    p.current_percent <- x;
+    let%lwt () = Lwt_io.printf "\r%s: %d%%" p.prefix x in
+    Lwt_io.flush Lwt_io.stdout
+  end else
+    return ()
+
+let close p =
+  let%lwt () = Lwt_io.printf "\r%s: 100%%\n" p.prefix in
+  Lwt_io.flush Lwt_io.stdout
diff --git a/tests/progress.mli b/tests/progress.mli
new file mode 100644
index 0000000..3630121
--- /dev/null
+++ b/tests/progress.mli
@@ -0,0 +1,21 @@
+(*
+ * progress.mli
+ * ------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Print progression on stdout/stderr *)
+
+type t
+
+val make : string -> int -> t Lwt.t
+  (** [make prefix max] *)
+
+val incr : t -> unit Lwt.t
+  (** [incr progress] *)
+
+val close : t -> unit Lwt.t
+  (** [close progress] *)
diff --git a/tests/syntax_extension.ml b/tests/syntax_extension.ml
new file mode 100644
index 0000000..b17f9af
--- /dev/null
+++ b/tests/syntax_extension.ml
@@ -0,0 +1,85 @@
+(*
+ * syntax_extension.ml
+ * -------------------
+ * Copyright : (c) 2009-2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* +-----------------------------------------------------------------+
+   | Type tests                                                      |
+   +-----------------------------------------------------------------+ *)
+
+(* Functionnal type *)
+let typ = <:obus_func< string -> uint -> string -> string -> string -> string list -> (string, variant) assoc -> int -> uint >>
+
+(* Alias *)
+type t = int with obus
+
+(* Alias with type parameters *)
+type ('a, 'b, 'c) t = (int * 'a list) structure * ('c, 'b) balbla with obus
+
+module type M = sig
+  (* Alias with type paramters in an interface *)
+  type ('a, 'b, 'c) t = (int * 'a list) structure * ('c, 'b) balbla
+    with obus(single -> basic -> basic -> container)
+end
+
+(* Automatic generation of a record combinator*)
+type foo = {
+  a : A.B.string;
+  b : int list;
+  c : (int, string, char) machin;
+  d : (int * byte_array * (int, string) dict_entry set) structure * int;
+} with obus
+
+(* Tuple *)
+let big_tuple =
+  <:obus_type< int * string * uint * int32 * byte * char * int list * int * int * string * variant * signature >>
+
+(* Very big tuple *)
+let super_big_tuple =
+  <:obus_type< x0 * x1 * x2 * x3 * x4 * x5 * x6 * x7 * x8 * x9 * x10 * x11 * x12 * x13 * x14 * x15 * x16 * x17 * x18 * x19 * x20 * x21 * x22 * x23 * x24 * x25 * x26 * x27 * x28 * x29 * x30 * x31 * x32 * x33 * x34 * x35 * x36 * x37 * x38 * x39 * x40 * x41 * x42 >>
+
+(* +-----------------------------------------------------------------+
+   | Exceptions                                                      |
+   +-----------------------------------------------------------------+ *)
+
+exception Fatal_error of string
+  with obus("org.foo.Error.FatalError")
+
+exception Simple_error of string
+  with obus(prefix ^ ".SimpleError")
+
+(* +-----------------------------------------------------------------+
+   | Proxy code                                                      |
+   +-----------------------------------------------------------------+ *)
+
+OP_method Plop : int
+OP_method Plop : int -> string
+OP_signal HaHaHa : string
+OP_property_r Foo : int list
+
+(* +-----------------------------------------------------------------+
+   | Proxy code with a custom proxy                                  |
+   +-----------------------------------------------------------------+ *)
+
+module Proxy = OBus_proxy.Make
+  (struct
+     type proxy = t
+     let cast x = x.proxy
+     let make x = failwith "not implemented"
+   end)
+
+OP_method SetCPUFreqGovernor : string
+OP_method MethodWithLabels : x : int -> y : int -> str : string -> unit
+
+(* +-----------------------------------------------------------------+
+   | Object code                                                     |
+   +-----------------------------------------------------------------+ *)
+
+OL_method Test : int -> int
+OL_method TestWithDefinition : int -> int = fun x -> x + 1
+OL_signal Foo : string * string
+OL_property_rw Prop : int = (fun obj -> return obj.x) (fun obj x -> obj.x <- x; return ())
diff --git a/tests/test_auth.ml b/tests/test_auth.ml
new file mode 100644
index 0000000..e6eee7c
--- /dev/null
+++ b/tests/test_auth.ml
@@ -0,0 +1,40 @@
+(*
+ * test_auth.ml
+ * ------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+
+let server_ic, client_oc = Lwt_io.pipe ()
+let client_ic, server_oc = Lwt_io.pipe ()
+
+let guid = OBus_uuid.generate ()
+let user_id = Unix.getuid ()
+
+let test_mech mech =
+  try%lwt
+    let%lwt () = Lwt.join
+      [(let%lwt _ = OBus_auth.Client.authenticate
+                    ~stream:(OBus_auth.stream_of_channels (client_ic, client_oc)) () in
+       return ());
+       let%lwt _ = OBus_auth.Server.authenticate
+                     ~user_id
+                     ~mechanisms:[mech]
+                     ~guid
+                     ~stream:(OBus_auth.stream_of_channels (server_ic, server_oc)) () in
+       return ()] in
+    let%lwt () = Lwt_io.printlf "authentication %s works!" (OBus_auth.Server.mech_name mech) in
+    return true
+  with exn ->
+    let%lwt () = Lwt_io.printlf "authentication %s do not works: %s" (OBus_auth.Server.mech_name mech) (Printexc.to_string exn) in
+    return false
+
+let test () =
+  let%lwt a = test_mech OBus_auth.Server.mech_external in
+  let%lwt b = test_mech OBus_auth.Server.mech_dbus_cookie_sha1 in
+  let%lwt c = test_mech OBus_auth.Server.mech_anonymous in
+  return (a && b && c)
diff --git a/tests/test_communication.ml b/tests/test_communication.ml
new file mode 100644
index 0000000..30c4a9b
--- /dev/null
+++ b/tests/test_communication.ml
@@ -0,0 +1,67 @@
+(*
+ * test_communication.ml
+ * ---------------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Test the communication with a message bus *)
+
+open Lwt
+open Lwt_io
+open OBus_message
+
+(* number of message to generate *)
+let test_count = 100
+
+let name = "obus.test.communication"
+
+let rec run_tests con = function
+  | 0 ->
+      return ()
+  | n ->
+      let message = Gen_random.message () in
+      let%lwt () = OBus_connection.send_message con {
+        message with
+          destination = name;
+          typ = Signal(["obus"; "test"], "obus.test", "test");
+      } in
+      run_tests con (n - 1)
+
+let rec wait_for_name con =
+  OBus_bus.name_has_owner con name >>= function
+    | true -> return ()
+    | false -> let%lwt () = Lwt_unix.sleep 0.1 in wait_for_name con
+
+let test () =
+  let%lwt () = Lwt_io.flush Lwt_io.stdout in
+  match Unix.fork () with
+    | 0 ->
+        let%lwt con = OBus_bus.session () in
+        let%lwt () = wait_for_name con in
+        let%lwt () = run_tests con test_count in
+        exit 0
+    | pid ->
+        let%lwt () = printlf "sending and receiving %d messages through the message bus." test_count in
+        let%lwt bus = OBus_bus.session () in
+        let%lwt _ = OBus_bus.request_name bus name in
+        let%lwt progress = Progress.make "received" test_count in
+        let waiter, wakener = wait () in
+        let count = ref 0 in
+        ignore (Lwt_sequence.add_r
+                  (function
+                     | {  typ = Signal(["obus"; "test"], "obus.test", "test") } ->
+                         ignore (Progress.incr progress);
+                         incr count;
+                         if !count = test_count then
+                           wakeup wakener true;
+                         None
+                     | msg ->
+                         Some msg)
+                  (OBus_connection.incoming_filters bus));
+        let%lwt result = waiter in
+        let%lwt () = Progress.close progress in
+        let%lwt _ = Lwt_unix.waitpid [] pid in
+        return result
diff --git a/tests/test_gc.ml b/tests/test_gc.ml
new file mode 100644
index 0000000..1a4638c
--- /dev/null
+++ b/tests/test_gc.ml
@@ -0,0 +1,51 @@
+(*
+ * test_gc.ml
+ * ----------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+open Lwt_io
+
+let ok = ref false
+let finalise _  = ok := true
+
+let test () =
+  let success = true in
+  let%lwt bus = OBus_bus.session () in
+
+  let%lwt () = print "safety check: " in
+  let event = ref 0 in
+  ok := false;
+  Gc.finalise finalise event;
+  let event = 1 in
+  ignore event;
+  Gc.full_major ();
+  let%lwt () = printl (if !ok then "success" else "failure") in
+  let success = success && !ok in
+
+  let%lwt () = print "testing garbage collection of a signal without a switch: " in
+  let%lwt event = OBus_signal.connect (OBus_bus.name_owner_changed bus) in
+  ok := false;
+  Gc.finalise finalise event;
+  let event = 1 in
+  ignore event;
+  Gc.full_major ();
+  let%lwt () = printl (if !ok then "success" else "failure") in
+  let success = success && !ok in
+
+  let%lwt () = print "testing garbage collection of a signal with a switch: " in
+  let switch = Lwt_switch.create () in
+  let%lwt event = OBus_signal.connect ~switch (OBus_bus.name_owner_changed bus) in
+  ok := false;
+  Gc.finalise finalise event;
+  let event = 1 in
+  ignore event;
+  Gc.full_major ();
+  let%lwt () = printl (if !ok then "success" else "failure") in
+  let success = success && !ok in
+
+  return success
diff --git a/tests/test_serialization.ml b/tests/test_serialization.ml
new file mode 100644
index 0000000..7c9eef1
--- /dev/null
+++ b/tests/test_serialization.ml
@@ -0,0 +1,84 @@
+(*
+ * test_serialization.ml
+ * ---------------------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Testing of serialization/deserialization *)
+
+open Lwt
+open Lwt_io
+
+(* number of message to generate *)
+let test_count = 100
+
+type result = {
+  success : int;
+  (* Writing/reading succeed and original and resulting messages are equal *)
+  failure : int;
+  (* Writing/reading succeed but original and resulting messages are not equal *)
+  reading_error : int;
+  (* Failed to deserialize the message *)
+  writing_error : int;
+  (* Falied to serialize the message *)
+}
+
+let run_one_test byte_order msg acc =
+  try
+    let str, fds = OBus_wire.string_of_message ~byte_order msg in
+    let msg' = OBus_wire.message_of_string str fds in
+    if msg' = msg then
+      { acc with success = acc.success + 1 }
+    else begin
+      { acc with failure = acc.failure + 1 }
+    end
+  with
+    | OBus_wire.Data_error msg ->
+        { acc with writing_error = acc.writing_error + 1 }
+    | OBus_wire.Protocol_error msg ->
+        { acc with reading_error = acc.reading_error + 1 }
+
+let run_tests prefix byte_order l =
+  let%lwt progress = Progress.make prefix test_count in
+  let rec aux acc n = function
+    | [] ->
+        let%lwt () = Progress.close progress in
+        return acc
+    | msg :: l ->
+        let%lwt () = Progress.incr progress in
+        aux (run_one_test byte_order msg acc) (n + 1) l
+  in
+  aux { success = 0; failure = 0; reading_error = 0; writing_error = 0 } 0 l
+
+let print_result result =
+  let%lwt () = printf "     success: %d\n" result.success in
+  let%lwt () = printf "     failure: %d\n" result.failure in
+  let%lwt () = printf "     writing error: %d\n" result.writing_error in
+  let%lwt () = printf "     reading error: %d\n" result.reading_error in
+  return ()
+
+let rec gen_messages progress acc = function
+  | 0 ->
+      let%lwt () = Progress.close progress in
+      return acc
+  | n ->
+      let%lwt () = Progress.incr progress in
+      gen_messages progress (Gen_random.message () :: acc) (n - 1)
+
+let test () =
+  let%lwt progress = Progress.make (Printf.sprintf "generating %d messages" test_count) test_count in
+  let%lwt msgs = gen_messages progress [] test_count in
+  let%lwt () = printl "try to serialize/deserialize all messages and compare the result to the original message." in
+  let%lwt result_le = run_tests "  - in little endian" Lwt_io.Little_endian msgs in
+  let%lwt () = print_result result_le in
+  let%lwt result_be = run_tests "  - in big endian" Lwt_io.Big_endian msgs in
+  let%lwt () = print_result result_be in
+  return (result_le.failure = 0
+      && result_le.reading_error = 0
+      && result_le.writing_error = 0
+      && result_be.failure = 0
+      && result_be.reading_error = 0
+      && result_be.writing_error = 0)
diff --git a/tests/test_validation.ml b/tests/test_validation.ml
new file mode 100644
index 0000000..a33f829
--- /dev/null
+++ b/tests/test_validation.ml
@@ -0,0 +1,59 @@
+(*
+ * test_validation.ml
+ * ------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Lwt
+open Lwt_io
+
+let good = [
+  OBus_string.validate "azerty";
+  OBus_string.validate "Jérémie";
+
+  OBus_path.validate "/";
+  OBus_path.validate "/a";
+  OBus_path.validate "/a/b";
+
+  OBus_name.validate_bus ":1.1";
+  OBus_name.validate_bus ":a.2";
+  OBus_name.validate_bus "foo.bar";
+  OBus_name.validate_bus "a.b.c.d";
+]
+
+let bad = [
+  OBus_string.validate "\xe9";
+
+  OBus_path.validate "/dd//dd";
+  OBus_path.validate "/dd//";
+  OBus_path.validate "/dd/";
+  OBus_path.validate "";
+
+  OBus_name.validate_bus ":1..2";
+  OBus_name.validate_bus "a..b";
+]
+
+let test () =
+  let%lwt () = printl "Validation of all types of D-Bus strings" in
+  let%lwt () =
+    Lwt_list.iter_s
+      (function
+         | Some err ->
+             printlf "valid string recognized as bad: %s" (OBus_string.error_message err)
+         | None ->
+             return ())
+      good
+  in
+  let%lwt () =
+    Lwt_list.iter_s
+      (function
+         | None ->
+             printlf "invalid string recognized as good"
+         | Some _ ->
+             return ())
+      bad
+  in
+  return (List.for_all ((=) None) good && List.for_all ((<>) None) bad)
diff --git a/tools/introspection/dune b/tools/introspection/dune
new file mode 100644
index 0000000..db394d5
--- /dev/null
+++ b/tools/introspection/dune
@@ -0,0 +1,6 @@
+(executables
+  (names        obus_dump obus_introspect)
+  (public_names obus-dump obus-introspect)
+  (modules      obus_dump obus_introspect)
+  (libraries    tools_util lwt obus.internals obus)
+  (preprocess   (pps lwt_ppx)))
diff --git a/tools/introspection/obus_dump.ml b/tools/introspection/obus_dump.ml
new file mode 100644
index 0000000..fb24c67
--- /dev/null
+++ b/tools/introspection/obus_dump.ml
@@ -0,0 +1,63 @@
+(*
+ * obus_dump.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.Infix
+
+let usage_msg = Printf.sprintf "Usage: %s <options> cmd args
+Execute 'cmd' and dump all messages it sent to session and system bus
+options are:" (Filename.basename (Sys.argv.(0)))
+
+let rec loop pp action what_bus a b =
+  let%lwt message = OBus_transport.recv a in
+  Format.fprintf pp "-----@\n@[<hv 2>%s on %s bus:@\n%a@]@." action what_bus
+    OBus_message.print message;
+  let%lwt () = OBus_transport.send b message in
+  loop pp action what_bus a b
+
+let launch pp what_bus laddresses =
+  let%lwt addresses = Lazy.force laddresses in
+  let%lwt server =
+    OBus_server.make_lowlevel ~capabilities:[`Unix_fd]
+      (fun server transport ->
+         ignore begin
+           let%lwt (_, bus) = OBus_transport.of_addresses ~capabilities:[`Unix_fd] addresses in
+           Lwt.choose [loop pp "message received" what_bus bus transport;
+                       loop pp "sending message" what_bus transport bus]
+         end)
+  in
+  Unix.putenv (Printf.sprintf "DBUS_%s_BUS_ADDRESS" (String.uppercase_ascii what_bus)) (OBus_address.to_string (OBus_server.addresses server));
+  Lwt.return ()
+
+
+let () =
+  let out = ref "/dev/stderr" and cmd_args = ref [] in
+  let anon_fun s = cmd_args := s :: !cmd_args in
+  let args = [
+    "-o", Arg.Set_string out, "<file> output messages to this file instead of stderr";
+    "--", Arg.Rest anon_fun, "command separator";
+  ] in
+  Arg.parse args anon_fun usage_msg;
+
+  let cmd_args = List.rev !cmd_args in
+  let cmd = match cmd_args with
+    | [] ->
+        Arg.usage args usage_msg;
+        exit 2
+    | x :: _ -> x
+  in
+
+  let oc = open_out !out in
+  let pp = Format.formatter_of_out_channel oc in
+
+  Lwt_main.run begin
+    let%lwt () = launch pp "session" OBus_address.session <&> launch pp "system" OBus_address.system in
+    let%lwt _ = Lwt_unix.waitpid [] (Unix.create_process cmd (Array.of_list cmd_args) Unix.stdin Unix.stdout Unix.stderr) in
+    close_out oc;
+    Lwt.return ()
+  end
diff --git a/tools/introspection/obus_introspect.ml b/tools/introspection/obus_introspect.ml
new file mode 100644
index 0000000..d91aa5b
--- /dev/null
+++ b/tools/introspection/obus_introspect.ml
@@ -0,0 +1,93 @@
+(*
+ * obus_introspect.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 recursive = ref false
+let anons = ref []
+let session = ref false
+let system = ref false
+let address = ref None
+let obj_mode = ref false
+
+let args = [
+  "-rec", Arg.Set recursive, "introspect recursively all sub-nodes";
+  "-session", Arg.Set session, "the service is on the session bus (the default)";
+  "-system", Arg.Set system, "the service is on the system bus";
+  "-address", Arg.String (fun addr -> address := Some addr), "the service is on the given message bus";
+  "-objects", Arg.Set obj_mode, "list objects with interfaces they implements instead of interfaces";
+]
+
+let usage_msg = Printf.sprintf "Usage: %s <option> <destination> <path>
+Introspect a D-Bus service (print only interfaces).
+options are:" (Filename.basename (Sys.argv.(0)))
+
+module Interface_map = Map.Make(struct type t = string let compare = compare end)
+
+let rec get proxy =
+  let%lwt interfaces, children = OBus_proxy.introspect proxy in
+  let map = List.fold_left (fun map (name, content, annots) ->
+                              Interface_map.add name (content, annots) map)
+    Interface_map.empty interfaces in
+  let nodes = [(proxy, List.map (fun (name, _, _) -> name) interfaces)] in
+  match !recursive with
+    | true ->
+        List.fold_left
+          (fun t1 t2 ->
+             let%lwt nodes1, map1 = t1 and nodes2, map2 = t2 in
+             Lwt.return (nodes1 @ nodes2, Interface_map.fold Interface_map.add map1 map2))
+          (Lwt.return (nodes, map))
+          (List.map
+             (fun child ->
+                get { proxy with OBus_proxy.path = OBus_proxy.path proxy @ [child] })
+             children)
+    | false ->
+        Lwt.return (nodes, map)
+
+let main service path =
+  let%lwt bus = match !session, !system, !address with
+    | true, true, _
+    | true, _, Some _
+    | _, true, Some _ ->
+        prerr_endline "must specify at most one of -session, -system\n\n";
+        Arg.usage args usage_msg;
+        exit 1
+    | false, false, None
+    | true, false, None -> OBus_bus.session ()
+    | false, true, None -> OBus_bus.system ()
+    | false, false, Some addr -> OBus_bus.of_addresses (OBus_address.of_string addr)
+  in
+  let%lwt nodes, map = get (OBus_proxy.make (OBus_peer.make bus service) path) in
+  begin
+    match !obj_mode with
+      | false ->
+          OBus_introspect.output (Xmlm.make_output ~nl:true ~indent:(Some 2) (`Channel Pervasives.stdout))
+            (Interface_map.fold (fun name (content, annots) acc -> (name, content, annots) :: acc) map [], [])
+      | true ->
+          List.iter begin fun (proxy, interfaces) ->
+            print_endline (OBus_path.to_string (OBus_proxy.path proxy));
+            List.iter (Printf.printf " + %s\n") interfaces;
+            print_newline ();
+          end nodes
+  end;
+  Lwt.return ()
+
+let () =
+  Arg.parse args
+    (fun arg -> anons := arg :: !anons)
+    usage_msg;
+
+  let service, path = match !anons with
+    | [path; service] -> (service, OBus_path.of_string path)
+    | _ -> Arg.usage args usage_msg; exit 1
+  in
+  try
+    Lwt_main.run (main service path)
+  with
+    | OBus_introspect.Parse_failure((line, column), msg) ->
+        Lwt.ignore_result (Lwt_io.eprintlf "invalid introspection document returned by the service!:%d:%d: %s" line column msg);
+        exit 1
diff --git a/tools/tools_util/dune b/tools/tools_util/dune
new file mode 100644
index 0000000..b9807af
--- /dev/null
+++ b/tools/tools_util/dune
@@ -0,0 +1,5 @@
+(library
+ (name tools_util)
+ (modules term utils)
+ (wrapped false)
+ (libraries obus.internals OBus_idl))
\ No newline at end of file
diff --git a/tools/tools_util/term.ml b/tools/tools_util/term.ml
new file mode 100644
index 0000000..2f1d79f
--- /dev/null
+++ b/tools/tools_util/term.ml
@@ -0,0 +1,108 @@
+(*
+ * term.ml
+ * -------
+ * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(* Terms manipulation *)
+
+open Printf
+open OBus_introspect_ext
+
+(* +-----------------------------------------------------------------+
+   | D-Bus types --> term (implementation)                           |
+   +-----------------------------------------------------------------+ *)
+
+let rec impl = function
+  | Term("byte", []) -> term "basic_byte" []
+  | Term("boolean", []) -> term "basic_boolean" []
+  | Term("int16", []) -> term "basic_int16" []
+  | Term("int32", []) -> term "basic_int32" []
+  | Term("int64", []) -> term "basic_int64" []
+  | Term("uint16", []) -> term "basic_uint16" []
+  | Term("uint32", []) -> term "basic_uint32" []
+  | Term("uint64", []) -> term "basic_uint64" []
+  | Term("double", []) -> term "basic_double" []
+  | Term("string", []) -> term "basic_string" []
+  | Term("signature", []) -> term "basic_signature" []
+  | Term("object_path", []) -> term "basic_object_path" []
+  | Term("unix_fd", []) -> term "basic_unix_fd" []
+  | Term("array", [Term("byte", [])]) -> term "byte_array" []
+  | Term("dict", [tk; tv]) -> term "dict" [tk; impl tv]
+  | Term(name, tl) -> term name (List.map impl tl)
+  | Tuple tl -> tuple (List.map impl tl)
+
+(* +-----------------------------------------------------------------+
+   | D-Bus types --> term (interface)                                |
+   +-----------------------------------------------------------------+ *)
+
+let rec intf = function
+  | Term("byte", []) -> term "char" []
+  | Term("boolean", []) -> term "bool" []
+  | Term("int16", []) -> term "int" []
+  | Term("int32", []) -> term "int32" []
+  | Term("int64", []) -> term "int64" []
+  | Term("uint16", []) -> term "int" []
+  | Term("uint32", []) -> term "int32" []
+  | Term("uint64", []) -> term "int64" []
+  | Term("double", []) -> term "float" []
+  | Term("string", []) -> term "string" []
+  | Term("signature", []) -> term "OBus_value.signature" []
+  | Term("object_path", []) -> term "OBus_path.t" []
+  | Term("unix_fd", []) -> term "Unix.file_descr" []
+  | Term("array", [Term("byte", [])]) -> term "string" []
+  | Term("array", [t]) -> term "list" [intf t]
+  | Term("dict", [tk; tv]) -> term "list" [tuple [intf tk; intf tv]]
+  | Term("variant", []) -> term "OBus_value.V.single" []
+  | Term(name, tl) -> term name (List.map intf tl)
+  | Tuple tl -> tuple (List.map intf tl)
+
+(* +-----------------------------------------------------------------+
+   | Term printing (implementation)                                  |
+   +-----------------------------------------------------------------+ *)
+
+let rec print_impl top oc = function
+  | Term(id, []) ->
+      output_string oc id
+  | Term(id, tl) ->
+      if not top then output_char oc '(';
+      output_string oc id;
+      List.iter
+        (fun t ->
+           output_char oc ' ';
+           print_impl false oc t)
+        tl;
+      if not top then output_char oc ')'
+  | Tuple [] ->
+      if not top then output_char oc '(';
+      output_string oc "structure seq0";
+      if not top then output_char oc ')'
+  | Tuple tl ->
+      if not top then output_char oc '(';
+      fprintf oc "structure (seq%d" (List.length tl);
+      List.iter
+        (fun t ->
+           output_char oc ' ';
+           print_impl false oc t)
+        tl;
+      output_char oc ')';
+      if not top then output_char oc ')'
+
+(* +-----------------------------------------------------------------+
+   | Term printing (interface)                                       |
+   +-----------------------------------------------------------------+ *)
+
+let rec print_intf top oc = function
+  | Term(id, []) -> output_string oc id
+  | Term(id, [t]) -> fprintf oc "%a %s" (print_intf false) t id
+  | Term(id, tl) -> fprintf oc "(%a) %s" (print_seq true ", ") tl id
+  | Tuple [] -> output_string oc "unit"
+  | Tuple tl -> if top then print_seq false " * " oc tl else fprintf oc "(%a)" (print_seq false " * ") tl
+
+and print_seq top sep oc = function
+  | [] -> ()
+  | [t] -> print_intf top oc t
+  | t :: tl -> fprintf oc "%a%s%a" (print_intf top) t sep (print_seq top sep) tl
diff --git a/tools/tools_util/utils.ml b/tools/tools_util/utils.ml
new file mode 100644
index 0000000..96b02fc
--- /dev/null
+++ b/tools/tools_util/utils.ml
@@ -0,0 +1,148 @@
+(*
+ * utils.ml
+ * --------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+open OBus_value
+open OBus_introspect_ext
+
+module IFSet = Set.Make(struct
+                          type t = OBus_introspect_ext.interface
+                          let compare (n1, _, _, _) (n2, _, _, _) = String.compare n1 n2
+                        end)
+
+let parse_xml fname =
+  let ic = open_in fname in
+  try
+    let interfaces, _ = OBus_introspect.input (Xmlm.make_input ~entity:(fun _ -> Some "") ~strip:true (`Channel ic)) in
+    close_in ic;
+    let interfaces = List.map OBus_introspect_ext.decode interfaces in
+    List.fold_left (fun acc iface -> IFSet.add iface acc) IFSet.empty interfaces
+  with
+    | OBus_introspect.Parse_failure((line, column), msg) ->
+        Printf.eprintf "%s:%d:%d: %s.\n%!" fname line column msg;
+        exit 1
+
+let parse_idl fname =
+  try
+    List.fold_left (fun acc iface -> IFSet.add iface acc) IFSet.empty (OBus_idl.parse_file fname)
+  with exn ->
+    Format.eprintf "@[<v0>%s@]@." (Printexc.to_string exn);
+    exit 1
+
+let parse_file fname =
+  if Filename.check_suffix fname ".obus" then
+    parse_idl fname
+  else
+    parse_xml fname
+
+let file_name_of_interface_name name =
+  let result = Bytes.create (String.length name) in
+  for i = 0 to String.length name - 1 do
+    if name.[i] = '.' then
+      Bytes.set result i '_'
+    else
+      Bytes.set result i name.[i]
+  done;
+  Bytes.unsafe_to_string result
+
+let paren top s = if top then s else sprintf "(%s)" s
+
+let make_names l =
+  let rec aux n = function
+    | [] -> []
+    | _ :: l -> sprintf "x%d" n :: aux (n + 1) l
+  in
+  aux 1 l
+
+let rec convertor conv top = function
+  | Term(name, []) ->
+      conv top name
+  | Term("array", [t]) -> begin
+      match convertor conv false t with
+        | Some f -> Some(paren top (sprintf "List.map %s" f))
+        | None -> None
+    end
+  | Term("dict", [tk; tv]) -> begin
+      match convertor conv true tk, convertor conv true tv with
+        | None, None ->
+            None
+        | Some fk, None ->
+            Some(paren top (sprintf "List.map (fun (k, v) -> (%s k, v))" fk))
+        | None, Some fv ->
+            Some(paren top (sprintf "List.map (fun (k, v) -> (k, %s v))" fv))
+        | Some fk, Some fv ->
+            Some(paren top (sprintf "List.map (fun (k, v) -> (%s k, %s v))" fk fv))
+    end
+  | Term(name, args) ->
+      None
+  | Tuple tl ->
+      let l = List.map (convertor conv true) tl in
+      if List.exists (fun f -> f <> None) l then begin
+        let names = make_names tl in
+        Some(sprintf "(fun (%s) -> (%s))"
+               (String.concat ", " names)
+               (String.concat ", " (List.map2
+                                      (fun name conv ->
+                                         match conv with
+                                           | Some f -> sprintf "%s %s" f name
+                                           | None -> name)
+                                      names l)))
+      end else
+        None
+
+let dbus_symbols = [
+  "byte";
+  "boolean";
+  "int16";
+  "int32";
+  "int64";
+  "uint16";
+  "uint32";
+  "uint64";
+  "double";
+  "string";
+  "signature";
+  "object_path";
+  "unix_fd";
+  "array";
+  "dict";
+  "variant";
+]
+
+let convertor_send top typ =
+  convertor
+    (fun top t ->
+       match t with
+         | "int32" | "uint32" -> Some "Int32.of_int"
+         | "object_path" -> Some "OBus_proxy.path"
+         | name when List.mem name dbus_symbols -> None
+         | name -> Some("cast_" ^ name))
+    top typ
+
+let convertor_recv top typ =
+  convertor
+    (fun top t ->
+       match t with
+         | "int32" | "uint32" -> Some "Int32.to_int"
+         | "object_path" -> Some(paren top ("(fun x -> OBus_proxy.make ~peer:(OBus_context.sender context) ~path:x)"))
+         | name when List.mem name dbus_symbols -> None
+         | name -> Some("make_" ^ name))
+    top typ
+
+let make_annotation = function
+  | "org.freedesktop.DBus.Deprecated" -> "OBus_introspect.deprecated"
+  | "org.freedesktop.DBus.GLib.CSymbol" -> "OBus_introspect.csymbol"
+  | "org.freedesktop.DBus.Method.NoReply" -> "OBus_introspect.no_reply"
+  | "org.freedesktop.DBus.Property.EmitsChangedSignal" -> "OBus_introspect.emits_changed_signal"
+  | "org.ocamlcore.forge.obus.Enum" -> "OBus_introspect_ext.obus_enum"
+  | "org.ocamlcore.forge.obus.Flag" -> "OBus_introspect_ext.obus_flag"
+  | "org.ocamlcore.forge.obus.Type" -> "OBus_introspect_ext.obus_type"
+  | "org.ocamlcore.forge.obus.IType" -> "OBus_introspect_ext.obus_itype"
+  | "org.ocamlcore.forge.obus.OType" -> "OBus_introspect_ext.obus_otype"
+  | name -> Printf.sprintf "%S" name
diff --git a/tools/tools_util/utils.mli b/tools/tools_util/utils.mli
new file mode 100644
index 0000000..4f12a5d
--- /dev/null
+++ b/tools/tools_util/utils.mli
@@ -0,0 +1,43 @@
+(*
+ * utils.mli
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+(** Utilities for tools *)
+
+module IFSet : Set.S with type elt = OBus_introspect_ext.interface
+  (** Set of interfaces *)
+
+val parse_xml : string -> IFSet.t
+  (** [parse_xml file_name] parses [file_name] as an XML introspection
+      file *)
+
+val parse_idl : string -> IFSet.t
+  (** [parse_xml file_name] parses [file_name] as an obus IDL file *)
+
+val parse_file : string -> IFSet.t
+  (** [parse_file file_name] parses [file_name] as an XML
+      introspection file or as an IDL file (according to the file name
+      extension), and returns the set of interfaces it contains. *)
+
+val file_name_of_interface_name : OBus_name.interface -> string
+  (** Convert an interface name into a valid module file name *)
+
+val convertor_send : bool -> OBus_introspect_ext.term -> string option
+  (** [convertor_send paren typ] returns an expression which convert
+      caml values before they are sent. It returns [None] if no
+      conversion is needed. If [paren] is [true] then no parenthesis
+      will be used, otherwise the expression may be surrounded by
+      parenthesis if needed *)
+
+val convertor_recv : bool -> OBus_introspect_ext.term -> string option
+  (** [convertor_recv paren typ] returns an expression which convert
+      caml values after they are received. It returns [None] if no
+      conversion is needed. *)
+
+val make_annotation : OBus_introspect.name -> string
+  (** [make_annotation name] returns the code for the given annotation *)
diff --git a/tools/transformers/dune b/tools/transformers/dune
new file mode 100644
index 0000000..7175e64
--- /dev/null
+++ b/tools/transformers/dune
@@ -0,0 +1,11 @@
+(executables
+  (names        obus_gen_interface obus_gen_client
+                obus_gen_server obus_idl2xml
+                obus_xml2idl)
+  (public_names obus-gen-interface obus-gen-client
+                obus-gen-server obus-idl2xml
+                obus-xml2idl)
+  (modules      obus_gen_interface obus_gen_client
+                obus_gen_server obus_idl2xml
+                obus_xml2idl)
+ (libraries     tools_util obus.internals))
\ No newline at end of file
diff --git a/tools/transformers/obus_gen_client.ml b/tools/transformers/obus_gen_client.ml
new file mode 100644
index 0000000..f63ad54
--- /dev/null
+++ b/tools/transformers/obus_gen_client.ml
@@ -0,0 +1,310 @@
+(*
+ * obus_gen_client.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+open OBus_introspect_ext
+
+let prog_name = Filename.basename Sys.argv.(0)
+
+let make_names args =
+  let _, l =
+    List.fold_left
+      (fun (n, l) (name, typ) ->
+         match name with
+           | None -> (n + 1, (false, "x" ^ string_of_int n) :: l)
+           | Some "type" -> (n, (true, "typ") :: l)
+           | Some name -> (n, (true, name) :: l))
+      (1, [])
+      args
+  in
+  List.rev l
+
+(* Remove deprecated members *)
+let remove_deprecated members =
+  List.filter
+    (function
+       | Method(_, _, _, annotations)
+       | Signal(_, _, annotations)
+       | Property(_, _, _, annotations) ->
+           try
+             List.assoc OBus_introspect.deprecated annotations <> "true"
+           with Not_found ->
+             true)
+    members
+
+(* +-----------------------------------------------------------------+
+   | Implementation generation                                       |
+   +-----------------------------------------------------------------+ *)
+
+let print_names oc = function
+  | [] ->
+      output_string oc "()";
+  | [(_, name)] ->
+      output_string oc name
+  | (_, name) :: names ->
+      output_char oc '(';
+      output_string oc name;
+      List.iter (fun (_, name) -> fprintf oc ", %s" name) names;
+      output_char oc ')'
+
+let rec contains_path = function
+  | Term("object_path", []) -> true
+  | Term(_, l) -> List.exists contains_path l
+  | Tuple l -> List.exists contains_path l
+
+let make_convertors make_convertor names args =
+  List.map2
+    (fun (_, name) (_, typ) -> match make_convertor true typ with
+       | Some f -> Some(sprintf "let %s = %s %s in\n" name f name)
+       | None -> None)
+    names args
+
+let print_impl oc name members symbols annotations =
+  let module_name = String.capitalize_ascii (Utils.file_name_of_interface_name name) in
+  fprintf oc "\n\
+              module %s =\n\
+              struct\n\
+             \  open %s\n\n"
+    module_name module_name;
+  List.iter (fun (name, sym) -> fprintf oc "  type %s = type_%s\n" name name) symbols;
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           let i_names = make_names i_args and o_names = make_names o_args in
+           let i_convertors = make_convertors Utils.convertor_send i_names i_args
+           and o_convertors = make_convertors Utils.convertor_recv o_names o_args in
+           fprintf oc "\n  let %s proxy" (OBus_name.ocaml_lid name);
+           List.iter
+             (function
+                | (false, name) -> fprintf oc " %s" name
+                | (true, name) -> fprintf oc " ~%s" name)
+             i_names;
+           output_string oc " =\n";
+           List.iter
+             (function
+                | Some line -> fprintf oc "    %s" line
+                | None -> ())
+             i_convertors;
+           let need_context = List.exists (fun (_, typ) -> contains_path typ) o_args in
+           if List.for_all (fun conv -> conv = None) o_convertors then begin
+             if try List.assoc OBus_introspect.no_reply annotations = "true" with Not_found -> false then
+               fprintf oc "    OBus_method.call_no_reply m_%s proxy " name
+             else
+               fprintf oc "    OBus_method.call m_%s proxy " name;
+             print_names oc i_names;
+             output_char oc '\n'
+           end else begin
+             output_string oc "    let%lwt ";
+             if need_context then output_string oc "(context, ";
+             print_names oc o_names;
+             if need_context then
+               fprintf oc ") = OBus_method.call_with_context m_%s proxy " name
+             else
+               fprintf oc " = OBus_method.call m_%s proxy " name;
+             print_names oc i_names;
+             output_string oc " in\n";
+             List.iter
+               (function
+                  | Some line -> fprintf oc "    %s" line
+                  | None -> ())
+               o_convertors;
+             output_string oc "    return ";
+             print_names oc o_names;
+             output_char oc '\n'
+           end
+       | Signal(name, args, annotations) ->
+           let names = make_names args in
+           let convertors = make_convertors Utils.convertor_recv names args in
+           fprintf oc "\n  let %s proxy =\n" (OBus_name.ocaml_lid name);
+           if List.for_all (fun x -> x = None) convertors then
+             fprintf oc "    OBus_signal.make s_%s proxy\n" name
+           else begin
+             if List.exists (fun (_, typ) -> contains_path typ) args then
+               output_string oc "    OBus_signal.map_with_context\n\
+                                \      (fun context "
+             else
+               output_string oc "    OBus_signal.map\n\
+                                \      (fun ";
+             print_names oc names;
+             output_string oc " ->\n";
+             List.iter
+               (function
+                  | Some line -> fprintf oc "         %s" line
+                  | None -> ())
+               convertors;
+             output_string oc "         ";
+             print_names oc names;
+             output_string oc ")\n";
+             fprintf oc "      (OBus_signal.make s_%s proxy)\n" name
+           end
+       | Property(name, typ, access, annotations) ->
+           fprintf oc "\n  let %s proxy =\n" (OBus_name.ocaml_lid name);
+           match Utils.convertor_recv true typ, Utils.convertor_send true typ with
+             | Some f_recv, Some f_send -> begin
+                 let need_context = contains_path typ in
+                 fprintf oc "    OBus_property.map_%s%s\n"
+                   (match access with
+                      | Read -> "r"
+                      | Write -> "w"
+                      | Read_write -> "rw")
+                   (if need_context then "_with_context" else "");
+                 let ctx = if need_context then " context" else "" in
+                 if access = Read || access = Read_write then
+                   fprintf oc "      (fun%s x -> %s x)\n" ctx f_recv;
+                 if access = Write || access = Read_write then
+                   fprintf oc "      (fun x -> %s x)\n" f_send;
+                 fprintf oc "      (OBus_property.make p_%s proxy)\n" name
+               end
+             | None, None ->
+                 fprintf oc "    OBus_property.make p_%s proxy\n" name
+             | _ ->
+                 assert false)
+    members;
+  output_string oc "end\n"
+
+(* +-----------------------------------------------------------------+
+   | Interface generation                                            |
+   +-----------------------------------------------------------------+ *)
+
+let rec term_intf = function
+  | Term("byte", []) -> term "char" []
+  | Term("boolean", []) -> term "bool" []
+  | Term("int16", []) -> term "int" []
+  | Term("int32", []) -> term "int" []
+  | Term("int64", []) -> term "int64" []
+  | Term("uint16", []) -> term "int" []
+  | Term("uint32", []) -> term "int" []
+  | Term("uint64", []) -> term "int64" []
+  | Term("double", []) -> term "float" []
+  | Term("string", []) -> term "string" []
+  | Term("signature", []) -> term "OBus_value.signature" []
+  | Term("object_path", []) -> term "OBus_proxy.t" []
+  | Term("unix_fd", []) -> term "Unix.file_descr" []
+  | Term("array", [Term("byte", [])]) -> term "string" []
+  | Term("array", [t]) -> term "list" [term_intf t]
+  | Term("dict", [tk; tv]) -> term "list" [tuple[term_intf tk; term_intf tv]]
+  | Term("variant", []) -> term "OBus_value.V.single" []
+  | Term(name, tl) -> term name (List.map term_intf tl)
+  | Tuple tl -> tuple (List.map term_intf tl)
+
+let print_symbol oc name sym =
+  let typ, values =
+    match sym with
+      | Sym_enum(typ, values) -> typ, values
+      | Sym_flag(typ, values) -> typ, values
+  in
+  fprintf oc "  type %s =\n" name;
+  match values with
+    | [] ->
+        ()
+    | (key, name) :: rest ->
+        fprintf oc "    [ `%s" (String.capitalize_ascii name);
+        List.iter (fun (key, name) -> fprintf oc "\n    | `%s" (String.capitalize_ascii name)) rest;
+        fprintf oc " ]\n"
+
+let print_intf oc name members symbols annotations =
+  fprintf oc "\nmodule %s : sig\n" (String.capitalize_ascii (Utils.file_name_of_interface_name name));
+  List.iter (fun (name, sym) -> print_symbol oc name sym) symbols;
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           fprintf oc "  val %s : OBus_proxy.t -> " (OBus_name.ocaml_lid name);
+           List.iter
+             (function
+                | (None, typ) ->
+                    fprintf oc "%a -> " (Term.print_intf true) (term_intf typ)
+                | (Some name, typ) ->
+                    fprintf oc "%s : %a -> " name (Term.print_intf true) (term_intf typ))
+             i_args;
+           Term.print_intf true oc
+             (term "Lwt.t"
+                [tuple
+                   (List.map (fun (_, typ) -> term_intf typ) o_args)]);
+           output_char oc '\n'
+       | Signal(name, args, annotations) ->
+           fprintf oc "  val %s : OBus_proxy.t -> %a\n"
+             (OBus_name.ocaml_lid name)
+             (Term.print_intf true)
+             (term "OBus_signal.t"
+                [tuple (List.map (fun (_, typ) -> term_intf typ) args)])
+       | Property(name, typ, access, annotations) ->
+           fprintf oc "  val %s : OBus_proxy.t -> %a\n"
+             (OBus_name.ocaml_lid name)
+             (Term.print_intf true)
+             (term "OBus_property.t"
+                [term_intf typ;
+                 term
+                   (match access with
+                      | Read -> "[ `readable ]"
+                      | Write -> "[ `writable ]"
+                      | Read_write -> "[ `readable | `writable ]")
+                   []]))
+    members;
+  output_string oc "end\n"
+
+(* +-----------------------------------------------------------------+
+   | Entry-point                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let usage_message =
+  Printf.sprintf "Usage: %s <options> <file>\n\
+                  Generate OCaml proxy code for D-Bus interfaces.\n\
+                  options are:"
+    prog_name
+
+let keep_common = ref false
+let prefix = ref None
+
+let args = [
+  "-keep-common", Arg.Set keep_common, "do not ignore common interfaces";
+  "-o", Arg.String(fun str -> prefix := Some str), "<prefix> output file prefix";
+]
+
+let () =
+  let sources = ref [] in
+  Arg.parse args (fun s -> sources := s :: !sources) usage_message;
+
+  let source =
+    match !sources with
+      | [s] -> s
+      | _ -> Arg.usage args usage_message; exit 1
+  in
+
+  let prefix, intf_module =
+    match !prefix with
+      | Some str ->
+          (str, String.capitalize_ascii (Filename.basename str) ^ "_interfaces")
+      | None ->
+          let name = try Filename.chop_extension source with Invalid_argument _ -> source in
+          (name ^ "_client", String.capitalize_ascii name ^ "_interfaces")
+  in
+
+  let interfaces = Utils.parse_file source in
+
+  let oc_impl = open_out (prefix ^ ".ml") and oc_intf = open_out (prefix ^ ".mli") in
+
+  output_string oc_impl "open Lwt\n";
+  Printf.fprintf oc_impl "open %s\n" intf_module;
+
+  Utils.IFSet.iter
+    (fun (name, members, symbols, annotations) ->
+       if !keep_common ||
+         (match OBus_name.split name with
+            | "org" :: "freedesktop" :: "DBus" :: _ -> false
+            | _ -> true) then begin
+           print_impl oc_impl name (remove_deprecated members) symbols annotations;
+           print_intf oc_intf name (remove_deprecated members) symbols annotations
+         end)
+    interfaces;
+
+  close_out oc_impl;
+  close_out oc_intf;
+
+  printf "file \"%s.ml\" written\n" prefix;
+  printf "file \"%s.mli\" written\n" prefix
diff --git a/tools/transformers/obus_gen_interface.ml b/tools/transformers/obus_gen_interface.ml
new file mode 100644
index 0000000..3bd32a0
--- /dev/null
+++ b/tools/transformers/obus_gen_interface.ml
@@ -0,0 +1,481 @@
+(*
+ * obus_gen_interface.ml
+ * ---------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+open OBus_value
+open OBus_introspect_ext
+open OBus_introspect
+
+let mode : [ `Both | `Client | `Server ] ref = ref `Both
+let prog_name = Filename.basename Sys.argv.(0)
+
+(* +-----------------------------------------------------------------+
+   | Common printers                                                 |
+   +-----------------------------------------------------------------+ *)
+
+let term_intf typ =
+  Term.intf (OBus_introspect_ext.term_of_single typ)
+
+let term_impl typ =
+  Term.impl (OBus_introspect_ext.term_of_single typ)
+
+let tuple_intf types =
+  Term.intf (OBus_introspect_ext.term_of_sequence types)
+
+let tuple_impl types =
+  Term.impl (OBus_introspect_ext.term_of_sequence types)
+
+let print_record oc members =
+  output_string oc "  type 'a members = {\n";
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           fprintf oc "    m_%s : 'a OBus_object.t -> %a -> %a;\n"
+             name
+             (Term.print_intf true)
+             (tuple (List.map (fun (name, typ) -> term_intf typ) i_args))
+             (Term.print_intf true)
+             (term "Lwt.t" [(tuple (List.map (fun (name, typ) -> term_intf typ) o_args))])
+       | Signal(name, args, annotations) ->
+           ()
+       | Property(name, typ, Read, annotations) ->
+           fprintf oc "    p_%s : 'a OBus_object.t -> %a;\n"
+             name
+             (Term.print_intf true)
+             (term "React.signal" [term_intf typ])
+       | Property(name, typ, Write, annotations) ->
+           fprintf oc "    p_%s : 'a OBus_object.t -> %a -> unit Lwt.t;\n"
+             name
+             (Term.print_intf true)
+             (term_intf typ)
+       | Property(name, typ, Read_write, annotations) ->
+           fprintf oc "    p_%s : ('a OBus_object.t -> %a) * ('a OBus_object.t -> %a -> unit Lwt.t);\n"
+             name
+             (Term.print_intf true)
+             (term "React.signal" [term_intf typ])
+             (Term.print_intf true)
+             (term_intf typ))
+    members;
+  output_string oc "  }\n"
+
+let print_symbol oc name sym =
+  let typ, values =
+    match sym with
+      | Sym_enum(typ, values) -> typ, values
+      | Sym_flag(typ, values) -> typ, values
+  in
+  fprintf oc "  type type_%s =\n" name;
+  match values with
+    | [] ->
+        ()
+    | (key, name) :: rest ->
+        fprintf oc "    [ `%s" (String.capitalize_ascii name);
+        List.iter (fun (key, name) -> fprintf oc "\n    | `%s" (String.capitalize_ascii name)) rest;
+        fprintf oc " ]\n"
+
+(* +-----------------------------------------------------------------+
+   | Implementation generation                                       |
+   +-----------------------------------------------------------------+ *)
+
+let string_of_integer_enum = function
+  | V.Byte x ->
+      sprintf "%C" x
+  | V.Int16 x | V.Uint16 x ->
+      sprintf "%d" x
+  | V.Int32 x | V.Uint32 x ->
+      sprintf "%ldl" x
+  | V.Int64 x | V.Uint64 x ->
+      sprintf "%LdL" x
+  | _ ->
+      assert false
+
+let string_of_integer_flag = function
+  | V.Byte x ->
+      sprintf "%d" (Char.code x)
+  | V.Int16 x | V.Uint16 x ->
+      sprintf "%d" x
+  | V.Int32 x | V.Uint32 x ->
+      sprintf "%ldl" x
+  | V.Int64 x | V.Uint64 x ->
+      sprintf "%LdL" x
+  | _ ->
+      assert false
+
+let print_args oc args =
+  fprintf oc "(arg%d" (List.length args);
+  List.iter
+    (function
+       | (None, typ) ->
+           fprintf oc "\n                       (None, %a)"
+             (Term.print_impl true) (term_impl typ)
+       | (Some name, typ) ->
+           fprintf oc "\n                       (Some %S, %a)"
+             name (Term.print_impl true) (term_impl typ))
+    args;
+  output_char oc ')'
+
+let print_impl oc name members symbols annotations =
+  fprintf oc "module %s =\n\
+              struct\n\
+             \  let interface = %S\n"
+    (String.capitalize_ascii (Utils.file_name_of_interface_name name))
+    name;
+
+  (***** Symbols *****)
+
+  List.iter
+    (fun (name, sym) ->
+       print_symbol oc name sym;
+       match sym with
+         | Sym_enum(typ, values) ->
+             fprintf oc "  let cast_%s = function\n" name;
+             List.iter
+               (fun (key, name) ->
+                  fprintf oc "    | `%s -> %s\n"
+                    (String.capitalize_ascii name)
+                    (string_of_integer_enum key))
+               values;
+             fprintf oc "  let make_%s = function\n" name;
+             List.iter
+               (fun (key, name) ->
+                  fprintf oc "    | %s -> `%s\n"
+                    (string_of_integer_enum key)
+                    (String.capitalize_ascii name))
+               values;
+             fprintf oc "    | n -> Printf.ksprintf failwith \"invalid value for \\\"%s\\\": %s\" n\n"
+               name
+               (match typ with
+                  | T.Byte -> "%c"
+                  | T.Int16 | T.Uint16 -> "%d"
+                  | T.Int32 | T.Uint32 -> "%ld"
+                  | T.Int64 | T.Uint64 -> "%Ld"
+                  | _ -> assert false)
+         | Sym_flag(typ, values) ->
+             fprintf oc "  let cast_%s l =\n\
+                        \    let rec loop acc = function\n\
+                        \      | [] -> %sacc\n"
+               name
+               (if typ = T.Byte then "char_of_int " else "");
+             List.iter
+               (fun (key, name) ->
+                  fprintf oc "      | `%s :: rest -> loop (%s) rest\n"
+                    (String.capitalize_ascii name)
+                    (match key with
+                       | V.Byte x ->
+                           sprintf "acc lor %d" (Char.code x)
+                       | V.Int16 x | V.Uint16 x ->
+                           sprintf "acc lor %d" x
+                       | V.Int32 x | V.Uint32 x ->
+                           sprintf "Int32.logor acc %ldl" x
+                       | V.Int64 x | V.Uint64 x ->
+                           sprintf "Int64.logor acc %LdL" x
+                       | _ ->
+                           assert false))
+               values;
+             fprintf oc "    in\n\
+                        \    loop %s l\n"
+               (match typ with
+                  | T.Byte | T.Int16 | T.Uint16 -> "0"
+                  | T.Int32 | T.Uint32 -> "0l"
+                  | T.Int64 | T.Uint64 -> "0L"
+                  | _ -> assert false);
+             fprintf oc "  let make_%s n =\n\
+                        \    let l = [] in\n"
+               name;
+             if typ = T.Byte then
+               fprintf oc "    let n = int_of_char n in\n";
+             List.iter
+               (fun (key, name) ->
+                  fprintf oc "    let l = if %s then `%s :: l else l in\n"
+                    (match key with
+                       | V.Byte x ->
+                           sprintf "n land %d <> 0" (Char.code x)
+                       | V.Int16 x | V.Uint16 x ->
+                           sprintf "n land %d <> 0" x
+                       | V.Int32 x | V.Uint32 x ->
+                           sprintf "Int32.logand n %ldl <> 0l" x
+                       | V.Int64 x | V.Uint64 x ->
+                           sprintf "Int64.logand n %LdL <> 0L" x
+                       | _ -> assert false)
+                    (String.capitalize_ascii name))
+               values;
+             fprintf oc "    l\n")
+    symbols;
+
+  (***** Member description *****)
+
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           fprintf oc "  let m_%s = {\n\
+                      \    Method.interface = interface;\n\
+                      \    Method.member = %S;\n\
+                      \    Method.i_args = %a;\n\
+                      \    Method.o_args = %a;\n\
+                      \    Method.annotations = [%s];\n\
+                      \  }\n"
+             name name print_args i_args print_args o_args
+             (String.concat ";\n                          "
+                (List.map
+                   (fun (name, value) -> sprintf "(%s, %S)" (Utils.make_annotation name) value)
+                   annotations))
+       | Signal(name, args, annotations) ->
+           fprintf oc "  let s_%s = {\n\
+                      \    Signal.interface = interface;\n\
+                      \    Signal.member = %S;\n\
+                      \    Signal.args = %a;\n\
+                      \    Signal.annotations = [%s];\n\
+                      \  }\n"
+             name name print_args args
+             (String.concat ";\n                          "
+                (List.map
+                   (fun (name, value) -> sprintf "(%s, %S)" (Utils.make_annotation name) value)
+                   annotations))
+       | Property(name, typ, access, annotations) ->
+           fprintf oc "  let p_%s = {\n\
+                      \    Property.interface = interface;\n\
+                      \    Property.member = %S;\n\
+                      \    Property.typ = %a;\n\
+                      \    Property.access = Property.%s;\n\
+                      \    Property.annotations = [%s];\n\
+                      \  }\n"
+             name name (Term.print_impl true) (term_impl typ)
+             (match access with
+                | Read -> "readable"
+                | Write -> "writable"
+                | Read_write -> "readable_writable")
+             (String.concat ";\n                          "
+                (List.map
+                   (fun (name, value) -> sprintf "(%s, %S)" (Utils.make_annotation name) value)
+                   annotations)))
+    members;
+
+  (***** Interface description *****)
+
+  if !mode <> `Client then begin
+    if List.exists (function Method _ | Property _ -> true | _ -> false) members then
+      print_record oc members;
+    output_string oc "  let make members =\n";
+    fprintf oc "    OBus_object.make_interface_unsafe interface\n\
+               \      [\n";
+    List.iter
+      (fun (name, value) ->
+         fprintf oc "        (%s, %S);\n" (Utils.make_annotation name) value)
+      annotations;
+    fprintf oc "      ]\n\
+               \      [|\n";
+    List.iter
+      (function
+         | Method(name, i_args, o_args, annotations) ->
+             fprintf oc "        method_info m_%s members.m_%s;\n" name name
+         | _ ->
+             ())
+      members;
+    output_string oc "      |]\n      [|\n";
+    List.iter
+      (function
+         | Signal(name, args, annotations) ->
+             fprintf oc "        signal_info s_%s;\n" name
+         | _ ->
+             ())
+      members;
+    output_string oc "      |]\n      [|\n";
+    List.iter
+      (function
+         | Property(name, typ, Read, annotations) ->
+             fprintf oc "        property_r_info p_%s members.p_%s;\n" name name
+         | Property(name, typ, Write, annotations) ->
+             fprintf oc "        property_w_info p_%s members.p_%s;\n" name name
+         | Property(name, typ, Read_write, annotations) ->
+             fprintf oc "        property_rw_info p_%s (fst members.p_%s) (snd members.p_%s);\n" name name name
+         | _ ->
+             ())
+      members;
+    output_string oc "      |]\n";
+  end;
+  output_string oc "end\n"
+
+(* +-----------------------------------------------------------------+
+   | Interface generation                                            |
+   +-----------------------------------------------------------------+ *)
+
+let string_of_key_type = function
+  | T.Byte -> "char"
+  | T.Int16 | T.Uint16 -> "int"
+  | T.Int32 | T.Uint32 -> "int32"
+  | T.Int64 | T.Uint64 -> "int64"
+  | _ -> assert false
+
+let print_intf oc name members symbols annotations =
+  fprintf oc "module %s : sig\n" (String.capitalize_ascii (Utils.file_name_of_interface_name name));
+  fprintf oc "  val interface : OBus_name.interface\n";
+
+  (***** Symbols *****)
+
+  List.iter
+    (fun (name, sym) ->
+       print_symbol oc name sym;
+       match sym with
+         | Sym_enum(typ, values) ->
+             fprintf oc "  val make_%s : %s -> type_%s\n"
+               name
+               (string_of_key_type typ)
+               name;
+             fprintf oc "  val cast_%s : type_%s -> %s\n"
+               name
+               name
+               (string_of_key_type typ)
+         | Sym_flag(typ, values) ->
+             fprintf oc "  val make_%s : %s -> type_%s list\n"
+               name
+               (string_of_key_type typ)
+               name;
+             fprintf oc "  val cast_%s : type_%s list -> %s\n"
+               name
+               name
+               (string_of_key_type typ))
+    symbols;
+
+  (***** Member description *****)
+
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           fprintf oc "  val m_%s : %a\n"
+             name
+             (Term.print_intf true)
+             (term "Method.t"
+                [tuple_intf (List.map snd i_args);
+                 tuple_intf (List.map snd o_args)])
+       | Signal(name, args, annotations) ->
+           fprintf oc "  val s_%s : %a\n"
+             name
+             (Term.print_intf true)
+             (term "Signal.t"
+                [tuple_intf (List.map snd args)])
+       | Property(name, typ, access, annotations) ->
+           fprintf oc "  val p_%s : %a\n"
+             name
+             (Term.print_intf true)
+             (term "Property.t"
+                [term_intf typ;
+                 term
+                   (match access with
+                      | Read -> "[ `readable ]"
+                      | Write -> "[ `writable ]"
+                      | Read_write -> "[ `readable | `writable ]")
+                   []]))
+    members;
+
+  (***** Interface description *****)
+
+  if !mode <> `Client then begin
+    if List.exists (function Method _ | Property _ -> true | _ -> false) members then begin
+      print_record oc members;
+      output_string oc "  val make : 'a members -> 'a OBus_object.interface\n"
+    end else
+      output_string oc "  val make : unit -> 'a OBus_object.interface\n";
+  end;
+  output_string oc "end\n"
+
+(* +-----------------------------------------------------------------+
+   | Sorting                                                         |
+   +-----------------------------------------------------------------+ *)
+
+let compare_members ma mb =
+  match ma, mb with
+    | Method(name_a, i_args_a, _, _), Method(name_b, i_args_b, _, _) ->
+        String.compare name_a name_b
+    | Signal(name_a, _, _), Signal(name_b, _, _) ->
+        String.compare name_a name_b
+    | Property(name_a, _, _, _), Property(name_b, _, _, _) ->
+        String.compare name_a name_b
+    | Method _, _ -> -1
+    | _, Method _ -> 1
+    | Signal _, _ -> -1
+    | _, Signal _ -> 1
+
+let sort_members members = List.sort compare_members members
+
+(* +-----------------------------------------------------------------+
+   | Entry-point                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let usage_message =
+  Printf.sprintf "Usage: %s <options> <file>\n\
+                  Generate OCaml modules for D-Bus interfaces.\n\
+                  options are:" prog_name
+
+let keep_common = ref false
+let prefix = ref None
+
+let args = [
+  "-keep-common", Arg.Set keep_common, "do not ignore common interfaces";
+  "-o", Arg.String(fun str -> prefix := Some str), "<prefix> output file prefix";
+  "-mode",
+  Arg.Symbol(["both"; "client"; "server"],
+             (function
+                | "both" -> mode := `Both
+                | "client" -> mode := `Client
+                | "server" -> mode := `Server
+                | _ -> assert false)),
+  " code generation mode, defaults to \"both\""
+]
+
+let () =
+  let sources = ref [] in
+  Arg.parse args (fun s -> sources := s :: !sources) usage_message;
+
+  let source =
+    match !sources with
+      | [s] -> s
+      | _ -> Arg.usage args usage_message; exit 1
+  in
+
+  let interfaces = Utils.parse_file source in
+
+  let prefix =
+    match !prefix with
+      | Some str -> str
+      | None -> (try Filename.chop_extension source with Invalid_argument _ -> source) ^ "_interfaces"
+  in
+
+  let oc_impl = open_out (prefix ^ ".ml") and oc_intf = open_out (prefix ^ ".mli") in
+
+  fprintf oc_impl
+    "(* File auto-generated by %s, DO NOT EDIT. *)\n\
+     open OBus_value\n\
+     open OBus_value.C\n\
+     open OBus_member\n"
+    prog_name;
+
+  if !mode <> `Client then
+    output_string oc_impl "open OBus_object\n";
+
+  fprintf oc_intf
+    "(* File auto-generated by %s, DO NOT EDIT. *)\n\
+     open OBus_member\n"
+    prog_name;
+
+  Utils.IFSet.iter
+    (fun ((name, members, symbols, annotations) as interface) ->
+       if !keep_common ||
+         (match OBus_name.split name with
+            | "org" :: "freedesktop" :: "DBus" :: _ -> false
+            | _ -> true) then begin
+           (* We keeps only symbols from the extended interface *)
+           let name, members, annotations = OBus_introspect_ext.encode interface in
+           let members = sort_members members and annotations = List.sort compare annotations in
+           print_impl oc_impl name members symbols annotations;
+           print_intf oc_intf name members symbols annotations
+         end)
+    interfaces;
+
+  close_out oc_impl;
+  close_out oc_intf
diff --git a/tools/transformers/obus_gen_server.ml b/tools/transformers/obus_gen_server.ml
new file mode 100644
index 0000000..4aa454a
--- /dev/null
+++ b/tools/transformers/obus_gen_server.ml
@@ -0,0 +1,204 @@
+(*
+ * obus_gen_server.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+open Printf
+open OBus_introspect_ext
+open OBus_value
+
+let prog_name = Filename.basename Sys.argv.(0)
+
+let make_names args =
+  let _, l =
+    List.fold_left
+      (fun (n, l) (name, typ) ->
+         match name with
+           | None -> (n + 1, (false, "x" ^ string_of_int n) :: l)
+           | Some "type" -> (n, (true, "typ") :: l)
+           | Some name -> (n, (true, name) :: l))
+      (1, [])
+      args
+  in
+  List.rev l
+
+(* +-----------------------------------------------------------------+
+   | Implementation generation                                       |
+   +-----------------------------------------------------------------+ *)
+
+let print_names oc = function
+  | [] ->
+      output_string oc "()";
+  | [(_, name)] ->
+      output_string oc name
+  | (_, name) :: names ->
+      output_char oc '(';
+      output_string oc name;
+      List.iter (fun (_, name) -> fprintf oc ", %s" name) names;
+      output_char oc ')'
+
+let rec contains_path = function
+  | Term("object_path", []) -> true
+  | Term(_, l) -> List.exists contains_path l
+  | Tuple l -> List.exists contains_path l
+
+let make_convertors make_convertor names args =
+  List.map2
+    (fun (_, name) (_, typ) -> match make_convertor true typ with
+       | Some f -> Some(name, f)
+       | None -> None)
+    names args
+
+let print_impl oc name members symbols annotations =
+  let module_name = String.capitalize_ascii (Utils.file_name_of_interface_name name) in
+  fprintf oc "\n\
+              module %s =\n\
+              struct\n\
+             \  open %s\n\n"
+    module_name module_name;
+  List.iter (fun (name, sym) -> fprintf oc "  type %s = type_%s\n" name name) symbols;
+  List.iter
+    (function
+       | Signal(name, args, annotations) ->
+           let names = make_names args in
+           let convertors = make_convertors Utils.convertor_send names args in
+           fprintf oc "\n  let %s obj" (OBus_name.ocaml_lid name);
+           List.iter
+             (function
+                | (false, name) -> fprintf oc " %s" name
+                | (true, name) -> fprintf oc " ~%s" name)
+             names;
+           output_string oc " =\n";
+           List.iter
+             (function
+                | Some(name, f) -> fprintf oc "    let %s = %s %s in\n" name f name
+                | None -> ())
+             convertors;
+           fprintf oc "    OBus_signal.emit s_%s obj" name;
+           List.iter
+             (fun (_, name) -> fprintf oc " %s" name)
+             names;
+           output_char oc '\n'
+       | _ ->
+           ())
+    members;
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           fprintf oc "\n  let %s obj" (OBus_name.ocaml_lid name);
+           List.iter
+             (function
+                | (false, name) -> fprintf oc " %s" name
+                | (true, name) -> fprintf oc " ~%s" name)
+             (make_names i_args);
+           output_string oc " =\n    Lwt.fail (Failure \"not implemented\")\n"
+       | _ ->
+           ())
+    members;
+  fprintf oc "\n  let interface =\n\
+               \    %s.make {\n" module_name;
+  List.iter
+    (function
+       | Method(name, i_args, o_args, annotations) ->
+           let i_names = make_names i_args and o_names = make_names o_args in
+           let i_convertors = make_convertors Utils.convertor_recv i_names i_args
+           and o_convertors = make_convertors Utils.convertor_send o_names o_args in
+           fprintf oc "      m_%s = (\n\
+                      \        fun obj %a ->\n" name print_names i_names;
+           List.iter
+             (function
+                | Some(name, f) -> fprintf oc "          let %s = %s %s in\n" name f name
+                | None -> ())
+             i_convertors;
+           fprintf oc "          let%%lwt %a = %s (OBus_object.get obj)" print_names o_names (OBus_name.ocaml_lid name);
+           List.iter (fun (_, name) -> fprintf oc " %s" name) i_names;
+           output_string oc " in\n";
+           List.iter
+             (function
+                | Some(name, f) -> fprintf oc "          let %s = %s %s in\n" name f name
+                | None -> ())
+             o_convertors;
+           fprintf oc "          return %a\n\
+                      \      );\n"
+             print_names o_names
+       | Property(name, typ, access, annotations) ->
+           fprintf oc "      p_%s = " name;
+           if access = Read_write then output_char oc '(';
+           if access = Read || access = Read_write then
+             output_string oc "(fun obj -> failwith \"not implemented\")";
+           if access = Read_write then begin
+             output_string oc ",\n";
+             output_string oc (String.make (11 + String.length name) ' ')
+           end;
+           if access = Write || access = Read_write then
+             output_string oc "(fun obj x -> failwith \"not implemented\")";
+           if access = Read_write then
+             output_char oc ')';
+           output_string oc ";\n"
+       | _ ->
+           ())
+    members;
+  output_string oc "    }\n";
+  output_string oc "end\n"
+
+(* +-----------------------------------------------------------------+
+   | Entry-point                                                     |
+   +-----------------------------------------------------------------+ *)
+
+let usage_message =
+  Printf.sprintf "Usage: %s <options> <file>\n\
+                  Generate OCaml server code for D-Bus interfaces.\n\
+                  options are:"
+    prog_name
+
+let keep_common = ref false
+let prefix = ref None
+
+let args = [
+  "-keep-common", Arg.Set keep_common, "do not ignore common interfaces";
+  "-o", Arg.String(fun str -> prefix := Some str), "<prefix> output file prefix";
+]
+
+let () =
+  let sources = ref [] in
+  Arg.parse args (fun s -> sources := s :: !sources) usage_message;
+
+  let source =
+    match !sources with
+      | [s] -> s
+      | _ -> Arg.usage args usage_message; exit 1
+  in
+
+  let prefix, intf_module =
+    match !prefix with
+      | Some str ->
+          (str, String.capitalize_ascii (Filename.basename str) ^ "_interfaces")
+      | None ->
+          let name = try Filename.chop_extension source with Invalid_argument _ -> source in
+          (name ^ "_server", String.capitalize_ascii name ^ "_interfaces")
+  in
+
+  let interfaces = Utils.parse_file source in
+
+  let oc = open_out (prefix ^ ".ml") in
+
+  output_string oc "open Lwt\n";
+  Printf.fprintf oc "open %s\n" intf_module;
+
+  Utils.IFSet.iter
+    (fun (name, members, symbols, annotations) ->
+       if !keep_common ||
+         (match OBus_name.split name with
+            | "org" :: "freedesktop" :: "DBus" :: _ -> false
+            | _ -> true) then begin
+           print_impl oc name members symbols annotations
+         end)
+    interfaces;
+
+  close_out oc;
+
+  printf "file \"%s.ml\" written\n" prefix
diff --git a/tools/transformers/obus_idl2xml.ml b/tools/transformers/obus_idl2xml.ml
new file mode 100644
index 0000000..4383eb5
--- /dev/null
+++ b/tools/transformers/obus_idl2xml.ml
@@ -0,0 +1,47 @@
+(*
+ * obus_idl2xml.ml
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+let usage_message =
+  Printf.sprintf "Usage: %s <options> <file>\n\
+                  Generate a D-Bus introspection file from an obus IDL file.\n\
+                  options are:"
+    (Filename.basename Sys.argv.(0))
+
+let output = ref None
+
+let args = [
+  "-o", Arg.String(fun str -> output := Some str), "<file-name> output file name";
+]
+
+let () =
+  let sources = ref [] in
+  Arg.parse args (fun s -> sources := s :: !sources) usage_message;
+
+  let source =
+    match !sources with
+      | [s] -> s
+      | _ -> Arg.usage args usage_message; exit 1
+  in
+  let destination =
+    match !output with
+      | None ->
+          (try
+             Filename.chop_extension source
+           with Invalid_argument _ ->
+             source) ^ ".xml"
+      | Some name ->
+          name
+  in
+
+  let oc = open_out destination in
+  OBus_introspect.output
+    (Xmlm.make_output ~nl:true ~indent:(Some 2) (`Channel oc))
+    ((List.map OBus_introspect_ext.encode (Utils.IFSet.elements (Utils.parse_idl source)), []));
+  close_out oc;
+  Printf.printf "file \"%s\" written\n" destination
diff --git a/tools/transformers/obus_xml2idl.ml b/tools/transformers/obus_xml2idl.ml
new file mode 100644
index 0000000..989198b
--- /dev/null
+++ b/tools/transformers/obus_xml2idl.ml
@@ -0,0 +1,43 @@
+(*
+ * obus_xml2idl.ml
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+let usage_message =
+  Printf.sprintf "Usage: %s <options> <file>\n\
+                  Generate an obus IDL file from a D-Bus introspection file.\n\
+                  options are:"
+    (Filename.basename Sys.argv.(0))
+
+let output = ref None
+
+let args = [
+  "-o", Arg.String(fun str -> output := Some str), "<file-name> output file name";
+]
+
+let () =
+  let sources = ref [] in
+  Arg.parse args (fun s -> sources := s :: !sources) usage_message;
+
+  let source =
+    match !sources with
+      | [s] -> s
+      | _ -> Arg.usage args usage_message; exit 1
+  in
+  let destination =
+    match !output with
+      | None ->
+          (try
+             Filename.chop_extension source
+           with Invalid_argument _ ->
+             source) ^ ".obus"
+      | Some name ->
+          name
+  in
+
+  OBus_idl.print_file destination (Utils.IFSet.elements (Utils.parse_xml source));
+  Printf.printf "file \"%s\" written\n" destination
diff --git a/utils/doc/style.css b/utils/doc/style.css
new file mode 100644
index 0000000..fb02716
--- /dev/null
+++ b/utils/doc/style.css
@@ -0,0 +1,171 @@
+/* A style for ocamldoc. Daniel C. Buenzli, Jérémie Dimino */
+
+body {
+    padding: 0em;
+    border: 0em;
+    margin: 2em 10% 2em 10%;
+    font-weight: normal;
+    line-height: 130%;
+    text-align: justify;
+    background: white;
+    color : black;
+    min-width: 40ex;
+}
+
+pre, p, div, span, img, table, td, ol, ul, li {
+    padding: 0em;
+    border: 0em;
+    margin: 0em
+}
+
+h1, h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+    fontsize: 100%;
+    margin-bottom: 1em
+    padding: 1ex 0em 0em 0em;
+    border: 0em;
+    margin: 1em 0em 0em 0em;
+    font-weight : bold;
+    text-align: center;
+}
+
+h1 {
+    font-size : 140%
+}
+
+h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+    font-size : 100%;
+    border-top-style : none;
+    margin: 1ex 0em 0em 0em;
+    border: 1px solid #000000;
+    margin-top: 5px;
+    margin-bottom: 2px;
+    text-align: center;
+    padding: 2px;
+}
+
+h2 {
+    font-size : 120%;
+    background-color: #90BDFF ;
+}
+h3 {
+    background-color: #90DDFF;
+}
+h4 {
+    background-color: #90EDFF;
+}
+h5 {
+    background-color: #90FDFF;
+}
+h6 {
+    background-color: #C0FFFF;
+}
+div.h7 {
+    background-color: #E0FFFF;
+}
+div.h8 {
+    background-color: #F0FFFF;
+}
+div.h9 {
+    background-color: #FFFFFF;
+}
+
+.navbar {
+    padding-bottom : 1em;
+    margin-bottom: 1em;
+    border-bottom: 1px solid #000000;
+    border-bottom-style: dotted;
+}
+
+p {
+    padding: 1em 0ex 0em 0em
+}
+
+a, a:link, a:visited, a:active, a:hover {
+    color : #009;
+    text-decoration: none
+}
+a:hover {
+    color : #009;
+    text-decoration : none;
+    background-color: #5FFF88
+}
+
+hr {
+    border-style: none;
+}
+table {
+    font-size : 100% /* Why ? */
+}
+ul li {
+    padding: 1em 0em 0em 0em;
+    margin:0em 0em 0em 2.5ex
+}
+ol li {
+    padding: 1em 0em 0em 0em;
+    margin:0em 0em 0em 2em
+}
+
+pre {
+    margin: 3ex 0em 1ex 0em;
+    background-color: #edf0f9;
+}
+.keyword {
+    font-weight: bold;
+    color: #a020f0;
+}
+.keywordsign {
+    font-weight: bold;
+    color: #a020f0;
+}
+.typefieldcomment {
+    color : #b22222;
+}
+.keywordsign {
+    color: #a020f0;
+
+}
+.code {
+    font-size: 120%;
+    color: #5f5f5f;
+}
+.info {
+    margin: 0em 0em 0em 2em
+}
+.comment {
+    color : #b22222;
+}
+.constructor {
+    color : #072
+}
+.type {
+    color : #228b22;
+}
+.string {
+    color : #bc8f8f;
+}
+.warning {
+    color : Red;
+    font-weight : bold
+}
+
+div.sig_block {
+    margin-left: 2em
+}
+.typetable {
+    color : #b8860b;
+    border-style : hidden
+}
+.indextable {
+    border-style : hidden
+}
+.paramstable {
+    border-style : hidden;
+    padding: 5pt 5pt
+}
+
+.superscript {
+    font-size : 80%
+}
+.subscript {
+    font-size : 80%
+}
diff --git a/utils/obus-mode.el b/utils/obus-mode.el
new file mode 100644
index 0000000..729d2e7
--- /dev/null
+++ b/utils/obus-mode.el
@@ -0,0 +1,69 @@
+;; obus-mode.el
+;; ------------
+;; Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org>
+;; Licence   : BSD3
+
+(require 'tuareg)
+
+(defconst obus-keywords '("interface" "method" "signal"
+                          "property_r" "property_w" "property_rw"
+                          "annotation" "with" "enum" "flag")
+  "List of keywords for the obus-mode")
+
+(defconst obus-member-keywords '("method" "signal"
+                                 "property_r" "property_w" "property_rw")
+  "List of keywords used for defining D-Bus members")
+
+(defvar obus-file nil
+  "Whether the current buffer is an obus idl file")
+
+(defun obus-tuareg-mode-hook ()
+  "Setup the tuareg mode for obus idl files"
+  (if obus-file
+      (progn
+        (setq obus-file nil)
+        (make-local-variable 'tuareg-governing-phrase-regexp)
+        (make-local-variable 'tuareg-keyword-alist)
+        (make-local-variable 'tuareg-font-lock-keywords)
+
+        (setq tuareg-governing-phrase-regexp
+              (regexp-opt
+               '("interface" "method" "signal"
+                 "property_r" "property_w" "property_rw"
+                 "annotation" "enum" "flag")
+                 `words))
+        (setq tuareg-keyword-alist (mapcar (lambda (x) (cons x 2)) obus-keywords))
+
+        (setq tuareg-font-lock-keywords
+              (list
+               (list "[(){}:*=,]\\|->"
+                     0 'font-lock-keyword-face nil nil)
+               (list (regexp-opt obus-keywords `words)
+                     0 'font-lock-keyword-face nil nil)
+               (list (concat (regexp-opt obus-member-keywords `words) "[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\)\\>")
+                     2 'font-lock-function-name-face 'keep nil)
+               (list "\\<interface\\>[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\([.][A-Za-z0-9_]+\\)+\\)\\>"
+                     1 'font-lock-constant-face 'keep nil)
+               (list "\\<\\(enum\\|flag\\)\\>[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\)\\>"
+                     2 'font-lock-type-face 'keep nil)
+               (list "\\<\\([A-Za-z_][A-Za-z0-9_.]+\\)[ \t\n]*\\(=\\|:\\)"
+                     1 'font-lock-variable-name-face 'keep nil)
+               (list "\\([0-9][0-9a-zA-Z+-.]*\\|'.'\\|\"[^\"]*\"\\)[ \t\n]*:[ \t\n]*\\([A-Za-z_][A-Za-z0-9_]*\\)\\>"
+                     2 'font-lock-variable-name-face 'keep nil)
+               (list ":[ \t\n]*\\(\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)"
+                     1 'font-lock-type-face 'keep nil)
+               (list (regexp-opt obus-keywords `words)))))))
+
+(add-hook 'tuareg-mode-hook 'obus-tuareg-mode-hook)
+
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.obus\\'" . obus-mode))
+
+;;;###autoload
+(defun obus-mode ()
+  "Major mode for editing obus idl files"
+  (interactive)
+  (print "toto")
+  (setq obus-file t)
+  (tuareg-mode))
+
+(provide 'obus-mode)
diff --git a/utils/scripts/cpufreq-performance b/utils/scripts/cpufreq-performance
new file mode 100755
index 0000000..02c5aa8
--- /dev/null
+++ b/utils/scripts/cpufreq-performance
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * cpufreq-performance
+ * -------------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Set the cpufreq governor to performance on all cpus *)
+
+let () = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.Cpufreq.set_cpufreq_governor computer "performance"
+end
diff --git a/utils/scripts/cpufreq-powersave b/utils/scripts/cpufreq-powersave
new file mode 100755
index 0000000..d058921
--- /dev/null
+++ b/utils/scripts/cpufreq-powersave
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * cpufreq-powersave
+ * -----------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Set the cpufreq governor to powersave on all cpus *)
+
+let () = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.Cpufreq.set_cpufreq_governor computer "powersave"
+end
diff --git a/utils/scripts/multimedia-keys b/utils/scripts/multimedia-keys
new file mode 100755
index 0000000..2771f33
--- /dev/null
+++ b/utils/scripts/multimedia-keys
@@ -0,0 +1,56 @@
+#!/usr/bin/env ocamlscript
+(*
+ * multimedia-keys
+ * ---------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["lwt.syntax"; "obus.syntax"; "obus"]
+--
+
+(* Simple script which listen keyboard events emited by hal and run
+   commands *)
+
+open Lwt
+
+(* Configuration *)
+let commands = [
+  ("volume-up", "amixer -q set Master 5%+");
+  ("volume-down", "amixer -q set Master 5%-");
+]
+
+lwt () =
+  lwt bus = Lazy.force OBus_bus.system in
+
+  (* Tell the message bus we want to receive ButtonPressed events from
+     hal. *)
+  lwt () = OBus_bus.add_match bus (OBus_match.rule
+                                     ~sender:"org.freedesktop.Hal"
+                                     ~interface:"org.freedesktop.Hal.Device"
+                                     ~member:"Condition"
+                                     ~arguments:[(0, "ButtonPressed")] ()) in
+
+  (* Add a message filter. We use that instead of adding a signal
+     receiver because we do not care about which object send the
+     event. *)
+  ignore (Lwt_sequence.add_l
+            (function
+               | { OBus_message.typ = OBus_message.Signal(_, "org.freedesktop.Hal.Device", "Condition");
+                   OBus_message.body = OBus_value.V.([Basic(String "ButtonPressed"); Basic(String button)]) } ->
+                   begin match try Some(List.assoc button commands) with Not_found -> None with
+                     | Some command ->
+                         ignore_result (Lwt_unix.system command)
+                     | None ->
+                         ()
+                   end;
+                   Some msg
+               | msg ->
+                   Some msg)
+            (OBus_connection.incoming_filters bus));
+
+  (* Wait forever, the program will exit when the connection is
+     closed *)
+  fst (wait ())
diff --git a/utils/scripts/power-hibernate b/utils/scripts/power-hibernate
new file mode 100755
index 0000000..ec46763
--- /dev/null
+++ b/utils/scripts/power-hibernate
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * power-hibernate
+ * ---------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Make the computer to hibernate *)
+
+let _ = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.System_power_management.hibernate computer
+end
diff --git a/utils/scripts/power-reboot b/utils/scripts/power-reboot
new file mode 100755
index 0000000..4ea4dc1
--- /dev/null
+++ b/utils/scripts/power-reboot
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * power-reboot
+ * ------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Make the computer to reboot *)
+
+let _ = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.System_power_management.reboot computer
+end
diff --git a/utils/scripts/power-shutdown b/utils/scripts/power-shutdown
new file mode 100755
index 0000000..c2ef262
--- /dev/null
+++ b/utils/scripts/power-shutdown
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * power-shutdown
+ * --------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Make the computer to shutdown *)
+
+let _ = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.System_power_management.shutdown computer
+end
diff --git a/utils/scripts/power-suspend b/utils/scripts/power-suspend
new file mode 100755
index 0000000..9cdb7bf
--- /dev/null
+++ b/utils/scripts/power-suspend
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocamlscript
+(*
+ * power-suspend
+ * -------------
+ * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org>
+ * Licence   : BSD3
+ *
+ * This file is a part of obus, an ocaml implementation of D-Bus.
+ *)
+
+Ocaml.packs := ["obus.hal"; "lwt.syntax"]
+--
+
+(* Make the computer to suspend to ram *)
+
+let _ = Lwt_main.run begin
+  lwt computer = Lazy.force Hal_device.computer in
+  Hal_device.System_power_management.suspend computer 0
+end