├── .gitignore ├── dune-project ├── tools ├── tools_util │ ├── dune │ └── utils.mli ├── introspection │ ├── dune │ ├── obus_dump.ml │ └── obus_introspect.ml └── transformers │ ├── dune │ ├── obus_xml2idl.ml │ └── obus_idl2xml.ml ├── dune ├── .github └── CODEOWNERS ├── src ├── ppx │ ├── dune │ └── ppx_obus.ml ├── idl │ ├── dune │ ├── oBus_idl.mli │ └── lexer.mll ├── internals │ ├── dune │ ├── oBus_protocol.ml │ ├── oBus_path.mli │ ├── oBus_introspect.mli │ ├── oBus_string.mli │ ├── oBus_util.mli │ ├── oBus_name.mli │ ├── oBus_xml_parser.mli │ └── oBus_type_ext_lexer.mll └── protocol │ ├── oBus_config.ml │ ├── dune │ ├── oBus_info.mli │ ├── oBus_method.mli │ ├── oBus_uuid.mli │ ├── oBus_uuid.ml │ ├── oBus_info.ml │ ├── oBus_context.ml │ ├── oBus_resolver.mli │ ├── oBus_context.mli │ ├── oBus_method.ml │ ├── oBus_match_rule_lexer.mll │ ├── oBus_address.mli │ ├── oBus_peer.ml │ ├── oBus_interfaces.obus │ ├── oBus_wire.mli │ ├── oBus_proxy.ml │ ├── oBus_address_lexer.mll │ ├── oBus_transport.mli │ ├── oBus_server.mli │ ├── oBus_proxy.mli │ ├── oBus_member.ml │ └── oBus_signal.mli ├── examples ├── ping_pong.xml ├── hello.ml ├── eject.ml ├── list_services.ml ├── ping.ml ├── pong.ml ├── notify.ml ├── monitor.ml ├── dune ├── network_manager.ml ├── bus_functions.ml ├── battery_monitoring.ml └── signals.ml ├── docs ├── man │ ├── dune │ ├── obus-idl2xml.1 │ ├── obus-dump.1 │ ├── obus-xml2idl.1 │ ├── obus-introspect.1 │ ├── obus-gen-client.1 │ ├── obus-gen-server.1 │ └── obus-gen-interface.1 ├── manual │ └── Makefile └── apiref-intro ├── tests ├── dune ├── gen_random.mli ├── progress.mli ├── progress.ml ├── test_auth.ml ├── test_gc.ml ├── test_validation.ml ├── main.ml ├── test_communication.ml ├── test_serialization.ml └── syntax_extension.ml ├── bindings ├── hal │ ├── dune │ ├── hal_manager.mli │ └── hal_manager.ml ├── udisks │ ├── dune │ ├── uDisks_monitor.mli │ ├── uDisks_port.mli │ ├── uDisks_adapter.mli │ ├── uDisks_expander.mli │ ├── uDisks_monitor.ml │ ├── uDisks_adapter.ml │ ├── uDisks_port.ml │ └── uDisks_expander.ml ├── upower │ ├── dune │ ├── uPower_monitor.mli │ ├── uPower_monitor.ml │ ├── uPower_wakeups.mli │ ├── uPower.mli │ ├── uPower_wakeups.ml │ ├── uPower_policy.mli │ ├── uPower_device.mli │ ├── uPower_policy.ml │ ├── uPower.ml │ └── uPower_interfaces.obus ├── network-manager │ ├── dune │ ├── nm_monitor.mli │ ├── nm_dhcp4_config.ml │ ├── nm_ppp.mli │ ├── nm_dhcp4_config.mli │ ├── nm_ppp.ml │ ├── nm_ip6_config.mli │ ├── nm_vpn_connection.mli │ ├── nm_ip4_config.mli │ ├── nm_vpn_plugin.mli │ ├── nm_ip6_config.ml │ ├── nm_vpn_connection.ml │ ├── nm_monitor.ml │ ├── nm_ip4_config.ml │ ├── nm_connection.mli │ ├── nm_vpn_plugin.ml │ ├── nm_access_point.mli │ ├── nm_settings.mli │ ├── nm_manager.mli │ ├── nm_connection.ml │ ├── nm_access_point.ml │ └── nm_settings.ml ├── policykit │ ├── dune │ ├── policy_kit_interfaces.obus │ ├── policy_kit.ml │ └── policy_kit.mli └── notification │ ├── dune │ └── notification_interfaces.obus ├── .travis.yml ├── utils ├── scripts │ ├── power-reboot │ ├── power-shutdown │ ├── power-hibernate │ ├── power-suspend │ ├── cpufreq-powersave │ ├── cpufreq-performance │ └── multimedia-keys ├── obus-mode.el └── doc │ └── style.css ├── obus.opam ├── LICENSE ├── CHANGES.md └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | .merlin -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.4) 2 | (using menhir 2.0) 3 | (name obus) 4 | (version 1.2.5) 5 | -------------------------------------------------------------------------------- /tools/tools_util/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tools_util) 3 | (modules term utils) 4 | (wrapped false) 5 | (libraries obus.internals OBus_idl)) -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (release 3 | (flags (:standard -w -3-6-7-9-27-32-33-34-35-37-38-39))) 4 | (dev 5 | (flags (:standard -w -3-6-7-9-27-32-33-34-35-37-38-39)))) -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | # These are the default owners for everything in the repo. They will 2 | # be requested for review when someone opens a pull request. 3 | * @diml @pmetzger @Freyr666 4 | -------------------------------------------------------------------------------- /src/ppx/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_obus) 3 | (public_name obus.ppx) 4 | (kind ppx_rewriter) 5 | (synopsis "Utility syntax for defining D-Bus errors") 6 | (libraries ppxlib) 7 | (preprocess (pps ppxlib.metaquot))) 8 | -------------------------------------------------------------------------------- /src/idl/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name OBus_idl) 3 | (synopsis "DSL for defining D-Bus interfaces") 4 | (libraries obus_internals)) 5 | 6 | (ocamllex 7 | (modules lexer)) 8 | 9 | (menhir 10 | (modules parser)) 11 | -------------------------------------------------------------------------------- /src/internals/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_internals) 3 | (public_name obus.internals) 4 | (libraries lwt.unix lwt_log xmlm) 5 | (wrapped false) 6 | (preprocess (pps lwt_ppx))) 7 | 8 | (ocamllex oBus_type_ext_lexer) 9 | -------------------------------------------------------------------------------- /examples/ping_pong.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /docs/man/dune: -------------------------------------------------------------------------------- 1 | (install 2 | (section man) 3 | (files 4 | obus-dump.1 5 | obus-gen-client.1 6 | obus-gen-interface.1 7 | obus-gen-server.1 8 | obus-idl2xml.1 9 | obus-introspect.1 10 | obus-xml2idl.1)) -------------------------------------------------------------------------------- /tools/introspection/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names obus_dump obus_introspect) 3 | (public_names obus-dump obus-introspect) 4 | (modules obus_dump obus_introspect) 5 | (libraries tools_util lwt obus.internals obus) 6 | (preprocess (pps lwt_ppx))) 7 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (modules main gen_random progress 4 | test_serialization test_validation 5 | test_auth test_communication test_gc) 6 | (libraries lwt obus) 7 | (preprocess (pps lwt_ppx))) 8 | 9 | (alias 10 | (name runtest) 11 | (action (run ./main.exe))) 12 | -------------------------------------------------------------------------------- /bindings/hal/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_hal) 3 | (public_name obus.hal) 4 | (wrapped false) 5 | (libraries lwt obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets hal_interfaces.ml hal_interfaces.mli) 10 | (deps hal_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o hal_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /bindings/udisks/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_udisks) 3 | (public_name obus.udisks) 4 | (wrapped false) 5 | (libraries lwt obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets uDisks_interfaces.ml uDisks_interfaces.mli) 10 | (deps uDisks_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o uDisks_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /bindings/upower/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_upower) 3 | (public_name obus.upower) 4 | (wrapped false) 5 | (libraries lwt obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets uPower_interfaces.ml uPower_interfaces.mli) 10 | (deps uPower_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o uPower_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /tests/gen_random.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * gen_random.mli 3 | * -------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Generation of random test data *) 11 | 12 | val message : unit -> OBus_message.t 13 | (** Generate a random message *) 14 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 4 | script: bash -ex .travis-opam.sh 5 | sudo: required 6 | env: 7 | matrix: 8 | - OCAML_VERSION=4.04 9 | - OCAML_VERSION=4.05 10 | - OCAML_VERSION=4.06 11 | - OCAML_VERSION=4.07 12 | - OCAML_VERSION=4.08 13 | os: 14 | - linux 15 | -------------------------------------------------------------------------------- /bindings/network-manager/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_network_manager) 3 | (public_name obus.network_manager) 4 | (wrapped false) 5 | (libraries lwt lwt_log obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets nm_interfaces.ml nm_interfaces.mli) 10 | (deps nm_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o nm_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /bindings/policykit/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_policy_kit) 3 | (public_name obus.policykit) 4 | (wrapped false) 5 | (libraries lwt obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets policy_kit_interfaces.ml policy_kit_interfaces.mli) 10 | (deps policy_kit_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o policy_kit_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_monitor.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_monitor.mli 3 | * ------------------ 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Properties monitoring *) 11 | 12 | val monitor : OBus_property.monitor 13 | (** Monitor for properties of udisk interfaces. *) 14 | -------------------------------------------------------------------------------- /bindings/upower/uPower_monitor.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_monitor.mli 3 | * ------------------ 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Properties monitoring *) 11 | 12 | val monitor : OBus_property.monitor 13 | (** Monitor for properties of upower interfaces. *) 14 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_monitor.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_monitor.mli 3 | * -------------- 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Properties monitoring *) 11 | 12 | val monitor : OBus_property.monitor 13 | (** Monitor for properties of Network Manager interfaces. *) 14 | -------------------------------------------------------------------------------- /bindings/notification/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus_notification) 3 | (public_name obus.notification) 4 | (wrapped false) 5 | (libraries lwt obus) 6 | (preprocess (pps lwt_ppx ppx_obus))) 7 | 8 | (rule 9 | (targets notification_interfaces.ml notification_interfaces.mli) 10 | (deps notification_interfaces.obus) 11 | (action 12 | (run obus-gen-interface -keep-common -o notification_interfaces %{deps}))) 13 | -------------------------------------------------------------------------------- /src/protocol/oBus_config.ml: -------------------------------------------------------------------------------- 1 | (* -*- tuareg -*- 2 | * OBus_config.ml 3 | * -------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Localtion of the machine id file: *) 11 | let machine_uuid_file = "/var/lib/dbus/machine-id" 12 | 13 | (* Version of obus: *) 14 | let version = "1.2.0" 15 | -------------------------------------------------------------------------------- /docs/manual/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile 2 | # -------- 3 | # Copyright : (c) 2010, Jeremie Dimino 4 | # Licence : BSD3 5 | # 6 | # This file is a part of obus, an ocaml implementation of D-Bus. 7 | 8 | .PHONY: all clean clean-aux 9 | 10 | all: manual.pdf 11 | 12 | %.pdf: %.tex 13 | rubber --pdf $< 14 | 15 | clean: clean-aux 16 | rm -f *.pdf 17 | 18 | clean-aux: 19 | rm -f *.aux *.dvi *.log *.out *.toc *.html *.htoc *.haux 20 | -------------------------------------------------------------------------------- /bindings/policykit/policy_kit_interfaces.obus: -------------------------------------------------------------------------------- 1 | (* 2 | * policy_kit_interfaces.obus 3 | * -------------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | interface org.freedesktop.PolicyKit.AuthenticationAgent { 11 | method ObtainAuthorization : (action_id : string, xid : uint32, pid : uint32) -> (gained_authorization : boolean) 12 | } 13 | -------------------------------------------------------------------------------- /tools/transformers/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names obus_gen_interface obus_gen_client 3 | obus_gen_server obus_idl2xml 4 | obus_xml2idl) 5 | (public_names obus-gen-interface obus-gen-client 6 | obus-gen-server obus-idl2xml 7 | obus-xml2idl) 8 | (modules obus_gen_interface obus_gen_client 9 | obus_gen_server obus_idl2xml 10 | obus_xml2idl) 11 | (libraries tools_util obus.internals)) -------------------------------------------------------------------------------- /bindings/network-manager/nm_dhcp4_config.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_dhcp4_config.ml 3 | * ------------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_DHCP4Config 11 | 12 | let options proxy = 13 | OBus_property.make ~monitor:Nm_monitor.monitor p_Options proxy 14 | 15 | let properties_changed proxy = 16 | OBus_signal.make s_PropertiesChanged proxy 17 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ppp.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ppp.mli 3 | * ---------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** PPP *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val need_secrets : t -> (string * string) Lwt.t 15 | val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t 16 | val set_state : t -> state : int -> unit Lwt.t 17 | -------------------------------------------------------------------------------- /examples/hello.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hello.ml 3 | * -------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Just open a connection with the message bus and print the assigned 11 | unique name *) 12 | 13 | let () = Lwt_main.run begin 14 | let%lwt bus = OBus_bus.session () in 15 | Lwt_io.printlf "My unique connection name is: %s" (OBus_connection.name bus) 16 | end 17 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_dhcp4_config.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_dhcp4_config.mli 3 | * ------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** DHCP4 configuration *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val options : t -> (string * OBus_value.V.single) list OBus_property.r 15 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 16 | -------------------------------------------------------------------------------- /src/protocol/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name obus) 3 | (public_name obus) 4 | (wrapped false) 5 | (synopsis "Pure Ocaml implementation of the D-Bus protocol") 6 | (libraries lwt.unix lwt_log lwt_react xmlm obus.internals) 7 | (preprocess (pps lwt_ppx ppx_obus))) 8 | 9 | (ocamllex oBus_address_lexer oBus_match_rule_lexer) 10 | 11 | (rule 12 | (targets oBus_interfaces.ml oBus_interfaces.mli) 13 | (deps oBus_interfaces.obus) 14 | (action 15 | (run obus-gen-interface -keep-common -o oBus_interfaces %{deps}))) 16 | -------------------------------------------------------------------------------- /tests/progress.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * progress.mli 3 | * ------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Print progression on stdout/stderr *) 11 | 12 | type t 13 | 14 | val make : string -> int -> t Lwt.t 15 | (** [make prefix max] *) 16 | 17 | val incr : t -> unit Lwt.t 18 | (** [incr progress] *) 19 | 20 | val close : t -> unit Lwt.t 21 | (** [close progress] *) 22 | -------------------------------------------------------------------------------- /utils/scripts/power-reboot: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * power-reboot 4 | * ------------ 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Make the computer to reboot *) 15 | 16 | let _ = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.System_power_management.reboot computer 19 | end 20 | -------------------------------------------------------------------------------- /utils/scripts/power-shutdown: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * power-shutdown 4 | * -------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Make the computer to shutdown *) 15 | 16 | let _ = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.System_power_management.shutdown computer 19 | end 20 | -------------------------------------------------------------------------------- /utils/scripts/power-hibernate: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * power-hibernate 4 | * --------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Make the computer to hibernate *) 15 | 16 | let _ = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.System_power_management.hibernate computer 19 | end 20 | -------------------------------------------------------------------------------- /utils/scripts/power-suspend: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * power-suspend 4 | * ------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Make the computer to suspend to ram *) 15 | 16 | let _ = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.System_power_management.suspend computer 0 19 | end 20 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ppp.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ppp.ml 3 | * --------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_PPP 11 | 12 | let need_secrets proxy = 13 | OBus_method.call m_NeedSecrets proxy () 14 | 15 | let set_ip4_config proxy ~config = 16 | OBus_method.call m_SetIp4Config proxy config 17 | 18 | let set_state proxy ~state = 19 | let state = Int32.of_int state in 20 | OBus_method.call m_SetState proxy state 21 | -------------------------------------------------------------------------------- /src/internals/oBus_protocol.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_protocol.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Protocol parameters *) 11 | 12 | let max_type_recursion_depth = 32 13 | let max_name_length = 255 14 | let max_array_size = 1 lsl 26 15 | let max_message_size = 1 lsl 27 16 | 17 | let bus_name = "org.freedesktop.DBus" 18 | let bus_path = ["org"; "freedesktop"; "DBus"] 19 | let bus_interface = "org.freedesktop.DBus" 20 | -------------------------------------------------------------------------------- /utils/scripts/cpufreq-powersave: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * cpufreq-powersave 4 | * ----------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Set the cpufreq governor to powersave on all cpus *) 15 | 16 | let () = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.Cpufreq.set_cpufreq_governor computer "powersave" 19 | end 20 | -------------------------------------------------------------------------------- /utils/scripts/cpufreq-performance: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * cpufreq-performance 4 | * ------------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["obus.hal"; "lwt.syntax"] 12 | -- 13 | 14 | (* Set the cpufreq governor to performance on all cpus *) 15 | 16 | let () = Lwt_main.run begin 17 | lwt computer = Lazy.force Hal_device.computer in 18 | Hal_device.Cpufreq.set_cpufreq_governor computer "performance" 19 | end 20 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ip6_config.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ip6_config.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Ip6 configuration *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val addresses : t -> (string * int) list OBus_property.r 15 | val nameservers : t -> string list OBus_property.r 16 | val domains : t -> string list OBus_property.r 17 | val routes : t -> (string * int * string * int) list OBus_property.r 18 | 19 | val properties : t -> OBus_property.group 20 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_vpn_connection.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_vpn_connection.mli 3 | * --------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** VPN connections *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val vpn_state_changed : t -> (int * int) OBus_signal.t 15 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 16 | 17 | val vpn_state : t -> int OBus_property.r 18 | val banner : t -> string OBus_property.r 19 | 20 | val properties : t -> OBus_property.group 21 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ip4_config.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ip4_config.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Ip4 configuration *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val addresses : t -> int list list OBus_property.r 15 | val nameservers : t -> int list OBus_property.r 16 | val wins_servers : t -> int list OBus_property.r 17 | val domains : t -> string list OBus_property.r 18 | val routes : t -> int list list OBus_property.r 19 | 20 | val properties : t -> OBus_property.group 21 | -------------------------------------------------------------------------------- /obus.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | version: "1.2.5" 3 | synopsis: "Pure Ocaml implementation of the D-Bus protocol" 4 | maintainer: "freyrnjordrson@gmail.com" 5 | authors: [ "Jérémie Dimino" ] 6 | homepage: "https://github.com/ocaml-community/obus" 7 | bug-reports: "https://github.com/ocaml-community/obus/issues" 8 | dev-repo: "git+https://github.com/ocaml-community/obus.git" 9 | license: "BSD-3-Clause" 10 | 11 | build: [ 12 | [ "dune" "build" "-p" name "-j" jobs ] 13 | ] 14 | 15 | depends: [ 16 | "ocaml" {>= "4.07"} 17 | "dune" {>= "1.4"} 18 | "menhir" {build & >= "20180528"} 19 | "xmlm" 20 | "lwt" {>= "4.3.0"} 21 | "lwt_ppx" 22 | "lwt_log" 23 | "lwt_react" 24 | "ppxlib" {>= "0.26.0"} 25 | ] 26 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_port.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_port.mli 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UDisks port interface *) 11 | 12 | include OBus_proxy.Private 13 | 14 | (** {6 Signals} *) 15 | 16 | val changed : t -> unit OBus_signal.t 17 | 18 | (** {6 Properties} *) 19 | 20 | val connector_type : t -> string OBus_property.r 21 | val number : t -> int OBus_property.r 22 | val parent : t -> UDisks_adapter.t OBus_property.r 23 | val adapter : t -> UDisks_adapter.t OBus_property.r 24 | val native_path : t -> string OBus_property.r 25 | 26 | val properties : t -> OBus_property.group 27 | -------------------------------------------------------------------------------- /bindings/policykit/policy_kit.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * policy_kit.ml 3 | * ------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let not_authorized = "org.freedesktop.PolicyKit.Error.NotAuthorized" 11 | 12 | open Policy_kit_interfaces.Org_freedesktop_PolicyKit_AuthenticationAgent 13 | 14 | let obtain_authorization ~action_id ?(xid=0) ~pid () = 15 | let%lwt session_bus = OBus_bus.session () in 16 | let proxy = 17 | OBus_proxy.make 18 | (OBus_peer.make session_bus "org.freedesktop.PolicyKit.AuthenticationAgent") 19 | [] 20 | in 21 | OBus_method.call m_ObtainAuthorization proxy (action_id, Int32.of_int xid, Int32.of_int pid) 22 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_adapter.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_adapter.mli 3 | * ------------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UDisks adapter interface *) 11 | 12 | include OBus_proxy.Private 13 | 14 | (** {6 Signals} *) 15 | 16 | val changed : t -> unit OBus_signal.t 17 | 18 | (** {6 Properties} *) 19 | 20 | val fabric : t -> string OBus_property.r 21 | val num_ports : t -> int OBus_property.r 22 | val driver : t -> string OBus_property.r 23 | val model : t -> string OBus_property.r 24 | val vendor : t -> string OBus_property.r 25 | val native_path : t -> string OBus_property.r 26 | 27 | val properties : t -> OBus_property.group 28 | -------------------------------------------------------------------------------- /bindings/notification/notification_interfaces.obus: -------------------------------------------------------------------------------- 1 | (* 2 | * notification_interfaces.obus 3 | * ---------------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | interface org.freedesktop.Notifications { 11 | method GetServerInformation : () -> (return_name : string, return_vendor : string, return_version : string, return_spec_version : string) 12 | method GetCapabilities : () -> (return_caps : string array) 13 | method CloseNotification : (id : uint32) -> () 14 | 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) 15 | } 16 | -------------------------------------------------------------------------------- /examples/eject.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * eject.ml 3 | * -------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Simple sample which eject all cdroms using Hal *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | 15 | let () = Lwt_main.run begin 16 | let%lwt manager = Hal_manager.manager () in 17 | let%lwt cdroms = Hal_manager.find_device_by_capability manager "storage.cdrom" in 18 | let%lwt () = printlf "cdrom(s) found: %d" (List.length cdroms) in 19 | Lwt_list.iter_p begin function cdrom -> 20 | let%lwt () = printlf "eject on device %s" (OBus_path.to_string (OBus_proxy.path (Hal_device.to_proxy cdrom))) in 21 | let%lwt _ = Hal_device.Storage.eject cdrom [] in 22 | return () 23 | end cdroms 24 | end 25 | -------------------------------------------------------------------------------- /docs/man/obus-idl2xml.1: -------------------------------------------------------------------------------- 1 | \" obus-idl2xml.1 2 | \" -------------- 3 | \" Copyright : (c) 2010, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | 7 | .TH OBUS-IDL2XML 1 "April 2010" 8 | 9 | .SH NAME 10 | obus-idl2xml \- convert an obus IDL file into a D-Bus introspection one 11 | 12 | .SH SYNOPSIS 13 | .B obus-idl2xml 14 | [ 15 | .I options 16 | ] 17 | .I input-file 18 | 19 | .SH DESCRIPTION 20 | 21 | .B obus-xml2idl 22 | generates a D-Bus xml introspection file from an obus IDL one 23 | 24 | .SH OPTIONS 25 | 26 | .IP "-o file-name" 27 | Use this name as output. It defaults to the input file name with the 28 | extension replaced by "xml". 29 | 30 | .IP "-help or --help" 31 | Display a short usage summary and exit. 32 | 33 | .SH AUTHOR 34 | Jérémie Dimino 35 | 36 | .SH "SEE ALSO" 37 | .BR obus-xml2idl. 38 | -------------------------------------------------------------------------------- /src/protocol/oBus_info.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_info.mli 3 | * ------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Various informations *) 11 | 12 | val version : string 13 | (** version of obus *) 14 | 15 | val machine_uuid : OBus_uuid.t Lwt.t Lazy.t 16 | (** UUID of the machine we are running on *) 17 | 18 | val protocol_version : int 19 | (** The version of the D-Bus protocol implemented by the library *) 20 | 21 | val max_name_length : int 22 | (** Maximum length of a name (=255). This limit applies to bus 23 | names, interfaces, and members *) 24 | 25 | val max_message_size : int 26 | (** Maximum size of a message. In this version of the protocol this 27 | is 2^27 bytes (128MB). *) 28 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_expander.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_expander.mli 3 | * ------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UDisks expander interface *) 11 | 12 | include OBus_proxy.Private 13 | 14 | (** {6 Signals} *) 15 | 16 | val changed : t -> unit OBus_signal.t 17 | 18 | (** {6 Properties} *) 19 | 20 | val native_path : t -> string OBus_property.r 21 | val vendor : t -> string OBus_property.r 22 | val model : t -> string OBus_property.r 23 | val revision : t -> string OBus_property.r 24 | val num_ports : t -> int OBus_property.r 25 | val upstream_ports : t -> UDisks_port.t list OBus_property.r 26 | val adapter : t -> UDisks_adapter.t OBus_property.r 27 | 28 | val properties : t -> OBus_property.group 29 | -------------------------------------------------------------------------------- /docs/man/obus-dump.1: -------------------------------------------------------------------------------- 1 | \" obus-dump.1 2 | \" ----------- 3 | \" Copyright : (c) 2009, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | \" This file is a part of obus, an ocaml implementation of D-Bus. 7 | 8 | .TH OBUS-DUMP 1 "October 2009" 9 | 10 | .SH NAME 11 | obus-dump \- a D-Bus message dumper 12 | 13 | .SH SYNOPSIS 14 | .B obus-dump 15 | [ 16 | .I options 17 | ] 18 | .I command 19 | [ 20 | .I arguments 21 | ] 22 | 23 | .SH DESCRIPTION 24 | 25 | .B obus-dump 26 | allows you to run a command and dumps all messages it tries to send 27 | through the session or system bus. 28 | 29 | .SH OPTIONS 30 | 31 | .IP "-o output-file" 32 | Uses 33 | .I output-file 34 | as output file instead of stderr. 35 | 36 | .IP "-help or --help" 37 | Display a short usage summary and exit. 38 | 39 | .SH AUTHOR 40 | Jérémie Dimino 41 | 42 | .SH "SEE ALSO" 43 | .BR obus-introspect (1), 44 | .BR obus-binder (1). 45 | -------------------------------------------------------------------------------- /src/protocol/oBus_method.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_method.mli 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** D-Bus methods *) 11 | 12 | val call : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> 'b Lwt.t 13 | (** [call meth proxy args] calls the method [meth] on the object 14 | pointed by [proxy], and wait for the reply. *) 15 | 16 | val call_with_context : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> (OBus_context.t * 'b) Lwt.t 17 | (** [call_with_context meth proxy args] is like {!call} except that 18 | it also returns the context of the method return *) 19 | 20 | val call_no_reply : ('a, 'b) OBus_member.Method.t -> OBus_proxy.t -> 'a -> unit Lwt.t 21 | (** [call_no_reply meth proxy args] is the same as {!call} except 22 | that it does not wait for a reply *) 23 | -------------------------------------------------------------------------------- /src/protocol/oBus_uuid.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_uuid.mli 3 | * ------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** D-Bus universally-unique IDs *) 11 | 12 | (** D-Bus uuid are used to distinguish message buses, addresses, and 13 | machines. 14 | 15 | Note that they are not compatible with RFC4122. *) 16 | 17 | type t 18 | 19 | val generate : unit -> t 20 | (** Generate a new uuid *) 21 | 22 | val of_string : string -> t 23 | (** Create a uuid from a string. The string must contain an 24 | hex-encoded uuid, i.e. be of length 32 and only contain 25 | hexadecimal characters. It raise a failure otherwise. 26 | 27 | @raise Invalid_argument if the string does not contain a valid 28 | uuid. *) 29 | 30 | val to_string : t -> string 31 | (** Return a hex-encoded string representation of an uuid. *) 32 | -------------------------------------------------------------------------------- /bindings/policykit/policy_kit.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * policy_kit.mli 3 | * -------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** PolicyKit interface *) 11 | 12 | val not_authorized : OBus_error.name 13 | (** Exception raised by services when trying to perform an action 14 | for which we do not have authorization from PolicyKit *) 15 | 16 | val obtain_authorization : action_id : string -> ?xid : int -> pid : int -> unit -> bool Lwt.t 17 | (** [obtain_authorization ~action_id ~xid ~pid] tries to obtain 18 | authorization for [action_id]. It returns whether it succeed or not. 19 | 20 | @param action_id PolicyKit action identifier; see PolKitAction 21 | @param xid X11 window ID for the top-level X11 window the dialog 22 | will be transient for 23 | @param pid Process ID to grant authorization to 24 | *) 25 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_vpn_plugin.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_vpn_plugin.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** VPN plugin interface *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val connect : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t 15 | val need_secrets : t -> settings : (string * (string * OBus_value.V.single) list) list -> string Lwt.t 16 | val disconnect : t -> unit Lwt.t 17 | val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t 18 | val set_failure : t -> reason : string -> unit Lwt.t 19 | 20 | val state_changed : t -> int OBus_signal.t 21 | val ip4_config : t -> (string * OBus_value.V.single) list OBus_signal.t 22 | val login_banner : t -> string OBus_signal.t 23 | val failure : t -> int OBus_signal.t 24 | 25 | val state : t -> int OBus_property.r 26 | -------------------------------------------------------------------------------- /examples/list_services.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * list_services.ml 3 | * ---------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* List services with their owner *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | 15 | let list name get_bus = 16 | let%lwt () = printlf "service name mapping on %s bus:" name in 17 | let%lwt bus = get_bus () in 18 | 19 | (* Get the list of all names on the session bus *) 20 | let%lwt names = OBus_bus.list_names bus in 21 | 22 | Lwt_list.iter_p 23 | (fun name -> 24 | let%lwt owner = OBus_bus.get_name_owner bus name in 25 | printlf " %s -> %s" owner name) 26 | 27 | (* Select only names which are not connection unique names *) 28 | (List.filter (fun s -> s.[0] <> ':') names) 29 | 30 | let () = Lwt_main.run begin 31 | let%lwt () = list "session" OBus_bus.session in 32 | list "system" OBus_bus.system 33 | end 34 | -------------------------------------------------------------------------------- /examples/ping.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * ping.ml 3 | * ------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Ping the pong service *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | 15 | open Ping_pong.Org_foo_bar 16 | 17 | let ping proxy msg = 18 | OBus_method.call m_Ping proxy msg 19 | 20 | let _ = Lwt_main.run begin 21 | let%lwt bus = OBus_bus.session () in 22 | 23 | (* Create a proxy for the remote object *) 24 | let proxy = OBus_proxy.make (OBus_peer.make bus "org.plop") ["plip"] in 25 | 26 | (* Send a ping *) 27 | let%lwt () = printl "trying to ping the pong service..." in 28 | 29 | try%lwt 30 | let%lwt msg = ping proxy "coucou" in 31 | printlf "received: %s" msg 32 | with 33 | | OBus_bus.Name_has_no_owner msg -> 34 | let%lwt () = printl "You must run pong to try this sample!" in 35 | exit 1 36 | | exn -> 37 | Lwt.fail exn 38 | end 39 | -------------------------------------------------------------------------------- /tests/progress.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * progress.ml 3 | * ----------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | type t = { 13 | mutable current_percent : int; 14 | mutable current : int; 15 | prefix : string; 16 | max : int; 17 | } 18 | 19 | let make prefix max = 20 | let%lwt () = Lwt_io.printf "%s: 0%%%!" prefix in 21 | return { 22 | prefix = prefix; 23 | max = max; 24 | current = 0; 25 | current_percent = 0; 26 | } 27 | 28 | let incr p = 29 | p.current <- p.current + 1; 30 | let x = p.current * 100 / p.max in 31 | if x <> p.current_percent then begin 32 | p.current_percent <- x; 33 | let%lwt () = Lwt_io.printf "\r%s: %d%%" p.prefix x in 34 | Lwt_io.flush Lwt_io.stdout 35 | end else 36 | return () 37 | 38 | let close p = 39 | let%lwt () = Lwt_io.printf "\r%s: 100%%\n" p.prefix in 40 | Lwt_io.flush Lwt_io.stdout 41 | -------------------------------------------------------------------------------- /src/idl/oBus_idl.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_idl.mli 3 | * ------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Intermediate language for writing D-Bus interfaces *) 11 | 12 | exception Parse_failure of string 13 | (** Exception raised when parsing fails for some reason. The 14 | argument is an error message. *) 15 | 16 | val parse : string -> OBus_introspect_ext.interface list 17 | (** [parse string] parses the given string. *) 18 | 19 | val parse_file : string -> OBus_introspect_ext.interface list 20 | (** [parse_file path] Helper to parse the contents of a file. *) 21 | 22 | val print : Format.formatter -> OBus_introspect_ext.interface list -> unit 23 | (** [print pp interfaces] prints the given interfaces on [pp] in the 24 | obus idl format *) 25 | 26 | val print_file : string -> OBus_introspect_ext.interface list -> unit 27 | (** Helper to print to a file *) 28 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ip6_config.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ip6_config.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_IP6Config 11 | 12 | let addresses proxy = 13 | OBus_property.map_r 14 | (fun x -> List.map (fun (x1, x2) -> (x1, Int32.to_int x2)) x) 15 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy) 16 | 17 | let nameservers proxy = 18 | OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy 19 | 20 | let domains proxy = 21 | OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy 22 | 23 | let routes proxy = 24 | OBus_property.map_r 25 | (fun x -> List.map (fun (x1, x2, x3, x4) -> (x1, Int32.to_int x2, x3, Int32.to_int x4)) x) 26 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy) 27 | 28 | let properties proxy = 29 | OBus_property.group ~monitor:Nm_monitor.monitor proxy interface 30 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_vpn_connection.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_vpn_connection.ml 3 | * -------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Connection 11 | 12 | let properties_changed proxy = 13 | OBus_signal.make s_PropertiesChanged proxy 14 | 15 | let vpn_state proxy = 16 | OBus_property.map_r 17 | (fun x -> Int32.to_int x) 18 | (OBus_property.make ~monitor:Nm_monitor.monitor p_VpnState proxy) 19 | 20 | let banner proxy = 21 | OBus_property.make ~monitor:Nm_monitor.monitor p_Banner proxy 22 | 23 | let vpn_state_changed proxy = 24 | OBus_signal.map 25 | (fun (state, reason) -> 26 | let state = Int32.to_int state in 27 | let reason = Int32.to_int reason in 28 | (state, reason)) 29 | (OBus_signal.make s_VpnStateChanged proxy) 30 | 31 | let properties proxy = 32 | OBus_property.group ~monitor:Nm_monitor.monitor proxy interface 33 | -------------------------------------------------------------------------------- /src/protocol/oBus_uuid.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_uuid.ml 3 | * ------------ 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | type t = string 11 | 12 | let of_string str = 13 | let fail _ = raise (Invalid_argument (Printf.sprintf "OBus_uuid.of_string(%S)" str)) in 14 | if String.length str <> 32 then fail (); 15 | try OBus_util.hex_decode str 16 | with _ -> fail () 17 | 18 | let to_string = OBus_util.hex_encode 19 | 20 | let generate () = 21 | let uuid = Bytes.create 16 in 22 | OBus_util.fill_random uuid 0 12; 23 | let v = Int32.of_float (Unix.time ()) in 24 | Bytes.set uuid 12 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 24))); 25 | Bytes.set uuid 13 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 16))); 26 | Bytes.set uuid 14 (Char.unsafe_chr (Int32.to_int (Int32.shift_right v 8))); 27 | Bytes.set uuid 15 (Char.unsafe_chr (Int32.to_int v)); 28 | Bytes.unsafe_to_string uuid 29 | -------------------------------------------------------------------------------- /examples/pong.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * pong.ml 3 | * ------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Very simple service with one object have a ping method *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | 15 | let ping obj msg = 16 | let%lwt () = printlf "received: %s" msg in 17 | return msg 18 | 19 | let interface = 20 | Ping_pong.Org_foo_bar.make { 21 | Ping_pong.Org_foo_bar.m_Ping = (fun obj msg -> ping (OBus_object.get obj) msg); 22 | } 23 | 24 | let () = Lwt_main.run begin 25 | let%lwt bus = OBus_bus.session () in 26 | 27 | (* Request a name *) 28 | let%lwt _ = OBus_bus.request_name bus "org.plop" in 29 | 30 | (* Create the object *) 31 | let obj = OBus_object.make ~interfaces:[interface] ["plip"] in 32 | OBus_object.attach obj (); 33 | 34 | (* Export the object on the connection *) 35 | OBus_object.export bus obj; 36 | 37 | (* Wait forever *) 38 | fst (wait ()) 39 | end 40 | -------------------------------------------------------------------------------- /src/protocol/oBus_info.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_info.ml 3 | * ------------ 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let section = Lwt_log.Section.make "obus(info)" 11 | 12 | let version = OBus_config.version 13 | 14 | let protocol_version = 1 15 | let max_name_length = OBus_protocol.max_name_length 16 | let max_message_size = OBus_protocol.max_message_size 17 | 18 | let read_uuid_file file = 19 | try%lwt 20 | let%lwt line = Lwt_io.with_file ~mode:Lwt_io.input file Lwt_io.read_line in 21 | Lwt.return (OBus_uuid.of_string line) 22 | with exn -> 23 | ignore (Lwt_log.error_f ~section ~exn "failed to read the local machine uuid from file %S" file); 24 | Lwt.fail exn 25 | 26 | let machine_uuid = lazy( 27 | try%lwt 28 | read_uuid_file OBus_config.machine_uuid_file 29 | with exn -> 30 | try%lwt 31 | read_uuid_file "/etc/machine-id" 32 | with _ -> 33 | Lwt.fail exn 34 | ) 35 | -------------------------------------------------------------------------------- /examples/notify.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * notify.ml 3 | * --------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | open Lwt_io 12 | 13 | let () = Lwt_main.run begin 14 | (* Open a first notification: *) 15 | let%lwt _ = Notification.notify ~summary:"Hello, world!" ~body:"ocaml is fun!" ~icon:"info" () in 16 | 17 | let%lwt () = Lwt_unix.sleep 0.5 in 18 | 19 | (* Open another one, with buttons on it: *) 20 | let%lwt handle = 21 | Notification.notify ~summary:"Actions test" ~body:"click on something!" 22 | ~category:"network" 23 | ~actions:[("coucou", `Coucou); ("plop", `Plop)] () 24 | in 25 | 26 | (* Then wait for the result: *) 27 | Notification.result handle >>= function 28 | | `Coucou -> eprintl "You pressed coucou!" 29 | | `Plop -> eprintl "You pressed plop!" 30 | | `Default -> eprintl "default action invoked" 31 | | `Closed -> eprintl "notification closed" 32 | end 33 | -------------------------------------------------------------------------------- /docs/man/obus-xml2idl.1: -------------------------------------------------------------------------------- 1 | \" obus-xml2idl.1 2 | \" -------------- 3 | \" Copyright : (c) 2010, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | 7 | .TH OBUS-XML2IDL 1 "April 2010" 8 | 9 | .SH NAME 10 | obus-xml2idl \- convert a D-Bus introspection file into an obus IDL one 11 | 12 | .SH SYNOPSIS 13 | .B obus-xml2idl 14 | [ 15 | .I options 16 | ] 17 | .I input-file 18 | 19 | .SH DESCRIPTION 20 | 21 | .B obus-xml2idl 22 | generates an obus IDL file from a D-Bus xml introspection file. THe 23 | file can then be used with other obus tools such as 24 | .B obus-gen-interface 25 | , 26 | .B obus-gen-client 27 | , 28 | .B obus-gen-server 29 | . 30 | 31 | The goal of the obus IDL is to allow you to write D-Bus interface with 32 | a syntax lighter than XML. 33 | 34 | .SH OPTIONS 35 | 36 | .IP "-o file-name" 37 | Use this name as output. It defaults to the input file name with the 38 | extension replaced by "obus". 39 | 40 | .IP "-help or --help" 41 | Display a short usage summary and exit. 42 | 43 | .SH AUTHOR 44 | Jérémie Dimino 45 | 46 | .SH "SEE ALSO" 47 | .BR obus-idl2xml. 48 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_monitor.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_monitor.ml 3 | * ------------- 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt_react 11 | open Lwt 12 | open OBus_value 13 | 14 | module String_map = Map.Make(String) 15 | 16 | let properties_changed interface = 17 | OBus_member.Signal.make 18 | ~interface 19 | ~member:"PropertiesChanged" 20 | ~args:(arg1 (Some "properties", C.dict C.string C.variant)) 21 | ~annotations:[] 22 | 23 | let monitor proxy interface switch = 24 | let%lwt event = 25 | OBus_signal.connect ~switch 26 | (OBus_signal.with_context 27 | (OBus_signal.make (properties_changed interface) proxy)) 28 | and context, dict = OBus_property.get_all_no_cache proxy interface in 29 | return (S.fold_s ~eq:(String_map.equal (=)) 30 | (fun map (context, updates) -> 31 | return (OBus_property.update_map context updates map)) 32 | (OBus_property.map_of_list context dict) 33 | event) 34 | -------------------------------------------------------------------------------- /src/protocol/oBus_context.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_context.ml 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | type t = { 11 | connection : OBus_connection.t; 12 | flags : OBus_message.flags; 13 | sender : OBus_peer.t; 14 | destination : OBus_peer.t; 15 | serial : OBus_message.serial; 16 | } 17 | 18 | let key = Lwt.new_key () 19 | 20 | let get () = 21 | match Lwt.get key with 22 | | Some ctx -> ctx 23 | | None -> failwith "OBus_context.get: not in a method call handler" 24 | 25 | let make ~connection ~message = { 26 | connection = connection; 27 | flags = OBus_message.flags message; 28 | sender = OBus_peer.make connection (OBus_message.sender message); 29 | destination = OBus_peer.make connection (OBus_message.destination message); 30 | serial = OBus_message.serial message; 31 | } 32 | 33 | let connection ctx = ctx.connection 34 | let flags ctx = ctx.flags 35 | let serial ctx = ctx.serial 36 | let sender ctx = ctx.sender 37 | let destination ctx = ctx.destination 38 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_monitor.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_monitor.ml 3 | * ----------------- 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt_react 11 | open Lwt 12 | 13 | module String_map = Map.Make(String) 14 | 15 | let changed interface = 16 | OBus_member.Signal.make 17 | ~interface 18 | ~member:"Changed" 19 | ~args:OBus_value.arg0 20 | ~annotations:[] 21 | 22 | let monitor proxy interface switch = 23 | let%lwt event = 24 | OBus_signal.connect ~switch 25 | (OBus_signal.with_context 26 | (OBus_signal.make (changed interface) proxy)) 27 | and context, dict = OBus_property.get_all_no_cache proxy interface in 28 | return (S.hold 29 | ~eq:(String_map.equal (=)) 30 | (OBus_property.map_of_list context dict) 31 | (E.map_s 32 | (fun (context, ()) -> 33 | let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in 34 | return (OBus_property.map_of_list context dict)) 35 | event)) 36 | -------------------------------------------------------------------------------- /bindings/upower/uPower_monitor.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_monitor.ml 3 | * ----------------- 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt_react 11 | open Lwt 12 | 13 | module String_map = Map.Make(String) 14 | 15 | let changed interface = 16 | OBus_member.Signal.make 17 | ~interface 18 | ~member:"Changed" 19 | ~args:OBus_value.arg0 20 | ~annotations:[] 21 | 22 | let monitor proxy interface switch = 23 | let%lwt event = 24 | OBus_signal.connect ~switch 25 | (OBus_signal.with_context 26 | (OBus_signal.make (changed interface) proxy)) 27 | and context, dict = OBus_property.get_all_no_cache proxy interface in 28 | return (S.hold 29 | ~eq:(String_map.equal (=)) 30 | (OBus_property.map_of_list context dict) 31 | (E.map_s 32 | (fun (context, ()) -> 33 | let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in 34 | return (OBus_property.map_of_list context dict)) 35 | event)) 36 | -------------------------------------------------------------------------------- /examples/monitor.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * monitor.ml 3 | * ---------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* This sample illustrate the use of threads in D-Bus + use of 11 | filters. Filters are part of the lowlevel api. *) 12 | 13 | open Lwt 14 | open OBus_bus 15 | open OBus_message 16 | open OBus_value 17 | 18 | let filter what_bus message = 19 | Format.printf "@[message intercepted on %s bus:@\n%a@]@." what_bus OBus_message.print message; 20 | (* Drop the message so we do not respond to method call *) 21 | None 22 | 23 | let add_filter what_bus get_bus = 24 | let%lwt bus = get_bus () in 25 | let _ = Lwt_sequence.add_r (filter what_bus) (OBus_connection.incoming_filters bus) in 26 | Lwt_list.iter_p 27 | (fun typ -> OBus_bus.add_match bus (OBus_match.rule ~typ ())) 28 | [ `Method_call; `Method_return; `Error; `Signal ] 29 | 30 | let () = Lwt_main.run begin 31 | let%lwt () = add_filter "session" OBus_bus.session <&> add_filter "system" OBus_bus.system in 32 | let%lwt () = Lwt_io.printlf "type Ctrl+C to stop" in 33 | fst (wait ()) 34 | end 35 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_adapter.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_adapter.ml 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | include OBus_proxy.Private 11 | 12 | open UDisks_interfaces.Org_freedesktop_UDisks_Adapter 13 | 14 | let changed proxy = 15 | OBus_signal.make s_Changed proxy 16 | 17 | let native_path proxy = 18 | OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy 19 | 20 | let vendor proxy = 21 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy 22 | 23 | let model proxy = 24 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy 25 | 26 | let driver proxy = 27 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Driver proxy 28 | 29 | let num_ports proxy = 30 | OBus_property.map_r 31 | (fun x -> Int32.to_int x) 32 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy) 33 | 34 | let fabric proxy = 35 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Fabric proxy 36 | 37 | let properties proxy = 38 | OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface 39 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_ip4_config.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_ip4_config.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_IP4Config 11 | 12 | let addresses proxy = 13 | OBus_property.map_r 14 | (fun x -> List.map (List.map Int32.to_int) x) 15 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy) 16 | 17 | let nameservers proxy = 18 | OBus_property.map_r 19 | (fun x -> List.map Int32.to_int x) 20 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy) 21 | 22 | let wins_servers proxy = 23 | OBus_property.map_r 24 | (fun x -> List.map Int32.to_int x) 25 | (OBus_property.make ~monitor:Nm_monitor.monitor p_WinsServers proxy) 26 | 27 | let domains proxy = 28 | OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy 29 | 30 | let routes proxy = 31 | OBus_property.map_r 32 | (fun x -> List.map (List.map Int32.to_int) x) 33 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy) 34 | 35 | let properties proxy = 36 | OBus_property.group ~monitor:Nm_monitor.monitor proxy interface 37 | -------------------------------------------------------------------------------- /bindings/upower/uPower_wakeups.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_wakeups.mli 3 | * ------------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UPower wakeups interface *) 11 | 12 | (** {6 Types} *) 13 | 14 | (** The data of all the processes and drivers which contribute to the 15 | wakeups on the system. *) 16 | type data = { 17 | data_is_userspace : bool; 18 | (** If the wakeup is from userspace ? *) 19 | 20 | data_id : int; 21 | (** The process ID of the application, or the IRQ for kernel 22 | drivers. *) 23 | 24 | data_value : float; 25 | (** The number of wakeups per second. *) 26 | 27 | data_cmdline : string option; 28 | (** The command line for the application, or [None] for kernel 29 | drivers. *) 30 | 31 | data_details : string; 32 | (** The details about the wakeup. *) 33 | } 34 | 35 | (** {6 Methods} *) 36 | 37 | val get_data : UPower.t -> data list Lwt.t 38 | val get_total : UPower.t -> int Lwt.t 39 | 40 | (** {6 Signals} *) 41 | 42 | val data_changed : UPower.t -> unit OBus_signal.t 43 | val total_changed : UPower.t -> int OBus_signal.t 44 | 45 | (** {6 Properties} *) 46 | 47 | val has_capability : UPower.t -> bool OBus_property.r 48 | -------------------------------------------------------------------------------- /tools/transformers/obus_xml2idl.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * obus_xml2idl.ml 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let usage_message = 11 | Printf.sprintf "Usage: %s \n\ 12 | Generate an obus IDL file from a D-Bus introspection file.\n\ 13 | options are:" 14 | (Filename.basename Sys.argv.(0)) 15 | 16 | let output = ref None 17 | 18 | let args = [ 19 | "-o", Arg.String(fun str -> output := Some str), " output file name"; 20 | ] 21 | 22 | let () = 23 | let sources = ref [] in 24 | Arg.parse args (fun s -> sources := s :: !sources) usage_message; 25 | 26 | let source = 27 | match !sources with 28 | | [s] -> s 29 | | _ -> Arg.usage args usage_message; exit 1 30 | in 31 | let destination = 32 | match !output with 33 | | None -> 34 | (try 35 | Filename.chop_extension source 36 | with Invalid_argument _ -> 37 | source) ^ ".obus" 38 | | Some name -> 39 | name 40 | in 41 | 42 | OBus_idl.print_file destination (Utils.IFSet.elements (Utils.parse_xml source)); 43 | Printf.printf "file \"%s\" written\n" destination 44 | -------------------------------------------------------------------------------- /docs/man/obus-introspect.1: -------------------------------------------------------------------------------- 1 | \" obus-introspect.1 2 | \" ----------------- 3 | \" Copyright : (c) 2009, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | \" This file is a part of obus, an ocaml implementation of D-Bus. 7 | 8 | .TH OBUS-INTROSPECT 1 "October 2009" 9 | 10 | .SH NAME 11 | obus-introspect \- a D-Bus introspecter 12 | 13 | .SH SYNOPSIS 14 | .B obus-intrpsoect 15 | [ 16 | .I options 17 | ] 18 | .I destination 19 | .I path 20 | 21 | .SH DESCRIPTION 22 | 23 | .B obus-introspect 24 | allow you to introspect a D-Bus service. Given a 25 | .B path 26 | it can introspect recursively all its children. By default it prints 27 | only all the interfaces it found, but it can also prints all object 28 | path with the interfaces they implements. 29 | 30 | .SH OPTIONS 31 | 32 | .IP -rec 33 | Introspects recursively all sub-nodes instead of just the one of 34 | .B path 35 | .I path 36 | 37 | .IP -session 38 | The service is on the session bus (the default). 39 | 40 | .IP -system 41 | The service is on the system bus. 42 | 43 | .IP -objects 44 | List objects with interfaces they implements instead of interfaces. 45 | 46 | .IP "-help or --help" 47 | Display a short usage summary and exit. 48 | 49 | .SH AUTHOR 50 | Jérémie Dimino 51 | 52 | .SH "SEE ALSO" 53 | .BR obus-dump (1), 54 | .BR obus-binder (1). 55 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_connection.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_connection.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Pierre Chambart 5 | * 2010, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | (** NetworkManager active connections *) 12 | 13 | (** An active connection is a connection that is currently being used *) 14 | 15 | include OBus_proxy.Private 16 | 17 | (** The connection state *) 18 | type state = 19 | [ `Unknown 20 | (** The active connection is in an unknown state. *) 21 | | `Activating 22 | (** The connection is activating. *) 23 | | `Activated 24 | (** The connection is activated. *) ] 25 | 26 | (** {6 Signals} *) 27 | 28 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 29 | 30 | (** {6 Properties} *) 31 | 32 | val service_name : t -> string OBus_property.r 33 | val connection : t -> Nm_settings.Connection.t OBus_property.r 34 | val specific_object : t -> OBus_proxy.t OBus_property.r 35 | val devices : t -> Nm_device.t list OBus_property.r 36 | val state : t -> state OBus_property.r 37 | val default : t -> bool OBus_property.r 38 | val vpn : t -> bool OBus_property.r 39 | 40 | val properties : t -> OBus_property.group 41 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (alias 2 | (name examples) 3 | (deps bus_functions.exe hello.exe list_services.exe monitor.exe eject.exe signals.exe 4 | battery_monitoring.exe network_manager.exe notify.exe ping.exe pong.exe)) 5 | 6 | (executables 7 | (names bus_functions hello list_services monitor) 8 | (modules bus_functions hello list_services monitor) 9 | (libraries lwt obus) 10 | (preprocess (pps lwt_ppx))) 11 | 12 | (executables 13 | (names eject signals) 14 | (modules eject signals) 15 | (libraries lwt obus obus_hal) 16 | (preprocess (pps lwt_ppx))) 17 | 18 | (executable 19 | (name battery_monitoring) 20 | (modules battery_monitoring) 21 | (libraries lwt obus obus_upower) 22 | (preprocess (pps lwt_ppx))) 23 | 24 | (executable 25 | (name network_manager) 26 | (modules network_manager) 27 | (libraries lwt obus obus_network_manager) 28 | (preprocess (pps lwt_ppx))) 29 | 30 | (executable 31 | (name notify) 32 | (modules notify) 33 | (libraries lwt obus obus_notification) 34 | (preprocess (pps lwt_ppx))) 35 | 36 | (executables 37 | (names ping pong) 38 | (modules ping pong ping_pong) 39 | (libraries lwt obus) 40 | (preprocess (pps lwt_ppx))) 41 | 42 | (rule 43 | (targets ping_pong.ml ping_pong.mli) 44 | (deps ping_pong.xml) 45 | (action 46 | (run obus-gen-interface -keep-common -o ping_pong %{deps}))) 47 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_port.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_port.ml 3 | * -------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | include OBus_proxy.Private 11 | 12 | open UDisks_interfaces.Org_freedesktop_UDisks_Port 13 | 14 | let changed proxy = 15 | OBus_signal.make s_Changed proxy 16 | 17 | let native_path proxy = 18 | OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy 19 | 20 | let adapter proxy = 21 | OBus_property.map_r_with_context 22 | (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) 23 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy) 24 | 25 | let parent proxy = 26 | OBus_property.map_r_with_context 27 | (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) 28 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_Parent proxy) 29 | 30 | let number proxy = 31 | OBus_property.map_r 32 | (fun x -> Int32.to_int x) 33 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_Number proxy) 34 | 35 | let connector_type proxy = 36 | OBus_property.make ~monitor:UDisks_monitor.monitor p_ConnectorType proxy 37 | 38 | let properties proxy = 39 | OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface 40 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_vpn_plugin.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_vpn_plugin.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | include OBus_proxy.Private 9 | 10 | open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Plugin 11 | 12 | let connect proxy ~connection = 13 | OBus_method.call m_Connect proxy connection 14 | 15 | let need_secrets proxy ~settings = 16 | OBus_method.call m_NeedSecrets proxy settings 17 | 18 | let disconnect proxy = 19 | OBus_method.call m_Disconnect proxy () 20 | 21 | let set_ip4_config proxy ~config = 22 | OBus_method.call m_SetIp4Config proxy config 23 | 24 | let set_failure proxy ~reason = 25 | OBus_method.call m_SetFailure proxy reason 26 | 27 | let state proxy = 28 | OBus_property.map_r 29 | (fun x -> Int32.to_int x) 30 | (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy) 31 | 32 | let state_changed proxy = 33 | OBus_signal.map 34 | (fun state -> 35 | let state = Int32.to_int state in 36 | state) 37 | (OBus_signal.make s_StateChanged proxy) 38 | 39 | let ip4_config proxy = 40 | OBus_signal.make s_Ip4Config proxy 41 | 42 | let login_banner proxy = 43 | OBus_signal.make s_LoginBanner proxy 44 | 45 | let failure proxy = 46 | OBus_signal.map 47 | (fun reason -> 48 | let reason = Int32.to_int reason in 49 | reason) 50 | (OBus_signal.make s_Failure proxy) 51 | -------------------------------------------------------------------------------- /bindings/hal/hal_manager.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hal_manager.mli 3 | * --------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** The Hal manager *) 11 | 12 | include OBus_proxy.Private 13 | 14 | val manager : unit -> t Lwt.t 15 | (** The Hal manager *) 16 | 17 | val get_all_devices : t -> Hal_device.t list Lwt.t 18 | val get_all_devices_with_properties : t -> (Hal_device.t * (string * Hal_device.property) list) list Lwt.t 19 | val device_exists : t -> Hal_device.udi -> bool Lwt.t 20 | val find_device_string_match : t -> string -> string -> Hal_device.t list Lwt.t 21 | val find_device_by_capability : t -> string -> Hal_device.t list Lwt.t 22 | val new_device : t -> Hal_device.t Lwt.t 23 | val remove : t -> Hal_device.t -> unit Lwt.t 24 | val commit_to_gdl : t -> string -> string -> unit Lwt.t 25 | val acquire_global_interface_lock : t -> string -> bool -> unit Lwt.t 26 | val release_global_interface_lock : t -> string -> unit Lwt.t 27 | val singleton_addon_is_ready : t -> string -> unit Lwt.t 28 | 29 | val device_added : t -> Hal_device.t OBus_signal.t 30 | val device_removed : t -> Hal_device.t OBus_signal.t 31 | val new_capability : t -> (Hal_device.t * string) OBus_signal.t 32 | val global_interface_lock_acquired : t -> (string * string * int) OBus_signal.t 33 | val global_interface_lock_released : t -> (string * string * int) OBus_signal.t 34 | -------------------------------------------------------------------------------- /src/protocol/oBus_resolver.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_resolver.mli 3 | * ----------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Bus name resolving *) 11 | 12 | (** This module implements bus name resolving and monitoring. 13 | 14 | - for a unique connection name, it means being notified when the 15 | peer owning this name exits 16 | 17 | - for a well-known name such as "org.domain.Serivce" it means 18 | knowing at each time who is the current owner and being notified 19 | when the service owner changes (i.e. the process implementing the 20 | service change). 21 | 22 | It is basically an abstraction for {!OBus_bus.get_owner} and 23 | {!OBus_bus.name_owner_changed}. You should prefer using it instead 24 | of implementing your own name monitoring because resolver are 25 | shared and obus internally uses them, so this avoids extra messages. 26 | 27 | Note that with a peer-to-peer connection, resolver will always act 28 | as if there is no owner. *) 29 | 30 | val make : ?switch : Lwt_switch.t -> OBus_connection.t -> OBus_name.bus -> OBus_name.bus React.signal Lwt.t 31 | (** [make ?switch bus name] creates a resolver which will monitor 32 | the name [name] on [bus]. It returns a signal holding the 33 | current owner of the name. It holds [""] when there is no 34 | owner. *) 35 | -------------------------------------------------------------------------------- /src/protocol/oBus_context.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_context.mli 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Message contexts *) 11 | 12 | (** {6 Types} *) 13 | 14 | (** A context contains information about the reception of a 15 | message. *) 16 | 17 | type t 18 | (** Type of a context. *) 19 | 20 | (** {6 Creation} *) 21 | 22 | val make : connection : OBus_connection.t -> message : OBus_message.t -> t 23 | (** Creates a context from the given connection and message *) 24 | 25 | (** {6 Retreival} *) 26 | 27 | val get : unit -> t 28 | (** In a method call handler, this returns the context of the method 29 | call. *) 30 | 31 | val key : t Lwt.key 32 | (** The key used for storing the context. *) 33 | 34 | (** {6 Projections} *) 35 | 36 | val connection : t -> OBus_connection.t 37 | (** Returns the connection part of a context *) 38 | 39 | val sender : t -> OBus_peer.t 40 | (** [sender context] returns the peer who sends the message *) 41 | 42 | val destination : t -> OBus_peer.t 43 | (** [destinatino context] returns the peer to which the message was 44 | sent *) 45 | 46 | val flags : t -> OBus_message.flags 47 | (** [flags context] returns the flags of the message that was 48 | received *) 49 | 50 | val serial : t -> OBus_message.serial 51 | (** Returns the serial of the message *) 52 | -------------------------------------------------------------------------------- /tests/test_auth.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * test_auth.ml 3 | * ------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | let server_ic, client_oc = Lwt_io.pipe () 13 | let client_ic, server_oc = Lwt_io.pipe () 14 | 15 | let guid = OBus_uuid.generate () 16 | let user_id = Unix.getuid () 17 | 18 | let test_mech mech = 19 | try%lwt 20 | let%lwt () = Lwt.join 21 | [(let%lwt _ = OBus_auth.Client.authenticate 22 | ~stream:(OBus_auth.stream_of_channels (client_ic, client_oc)) () in 23 | return ()); 24 | let%lwt _ = OBus_auth.Server.authenticate 25 | ~user_id 26 | ~mechanisms:[mech] 27 | ~guid 28 | ~stream:(OBus_auth.stream_of_channels (server_ic, server_oc)) () in 29 | return ()] in 30 | let%lwt () = Lwt_io.printlf "authentication %s works!" (OBus_auth.Server.mech_name mech) in 31 | return true 32 | with exn -> 33 | let%lwt () = Lwt_io.printlf "authentication %s do not works: %s" (OBus_auth.Server.mech_name mech) (Printexc.to_string exn) in 34 | return false 35 | 36 | let test () = 37 | let%lwt a = test_mech OBus_auth.Server.mech_external in 38 | let%lwt b = test_mech OBus_auth.Server.mech_dbus_cookie_sha1 in 39 | let%lwt c = test_mech OBus_auth.Server.mech_anonymous in 40 | return (a && b && c) 41 | -------------------------------------------------------------------------------- /tools/transformers/obus_idl2xml.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * obus_idl2xml.ml 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let usage_message = 11 | Printf.sprintf "Usage: %s \n\ 12 | Generate a D-Bus introspection file from an obus IDL file.\n\ 13 | options are:" 14 | (Filename.basename Sys.argv.(0)) 15 | 16 | let output = ref None 17 | 18 | let args = [ 19 | "-o", Arg.String(fun str -> output := Some str), " output file name"; 20 | ] 21 | 22 | let () = 23 | let sources = ref [] in 24 | Arg.parse args (fun s -> sources := s :: !sources) usage_message; 25 | 26 | let source = 27 | match !sources with 28 | | [s] -> s 29 | | _ -> Arg.usage args usage_message; exit 1 30 | in 31 | let destination = 32 | match !output with 33 | | None -> 34 | (try 35 | Filename.chop_extension source 36 | with Invalid_argument _ -> 37 | source) ^ ".xml" 38 | | Some name -> 39 | name 40 | in 41 | 42 | let oc = open_out destination in 43 | OBus_introspect.output 44 | (Xmlm.make_output ~nl:true ~indent:(Some 2) (`Channel oc)) 45 | ((List.map OBus_introspect_ext.encode (Utils.IFSet.elements (Utils.parse_idl source)), [])); 46 | close_out oc; 47 | Printf.printf "file \"%s\" written\n" destination 48 | -------------------------------------------------------------------------------- /bindings/upower/uPower.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower.mli 3 | * ---------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UPower main interface *) 11 | 12 | include OBus_peer.Private 13 | 14 | val daemon : unit -> t Lwt.t 15 | (** [daemon ()] returns the peer object for the upower daemon *) 16 | 17 | val general_error : OBus_error.name 18 | 19 | (** {6 Methods} *) 20 | 21 | val hibernate_allowed : t -> bool Lwt.t 22 | val hibernate : t -> unit Lwt.t 23 | val suspend_allowed : t -> bool Lwt.t 24 | val suspend : t -> unit Lwt.t 25 | val about_to_sleep : t -> unit Lwt.t 26 | val enumerate_devices : t -> UPower_device.t list Lwt.t 27 | 28 | (** {6 Signals} *) 29 | 30 | val resuming : t -> unit OBus_signal.t 31 | val sleeping : t -> unit OBus_signal.t 32 | val changed : t -> unit OBus_signal.t 33 | val device_changed : t -> UPower_device.t OBus_signal.t 34 | val device_removed : t -> UPower_device.t OBus_signal.t 35 | val device_added : t -> UPower_device.t OBus_signal.t 36 | 37 | (** {6 Properties} *) 38 | 39 | val lid_is_present : t -> bool OBus_property.r 40 | val lid_is_closed : t -> bool OBus_property.r 41 | val on_low_battery : t -> bool OBus_property.r 42 | val on_battery : t -> bool OBus_property.r 43 | val can_hibernate : t -> bool OBus_property.r 44 | val can_suspend : t -> bool OBus_property.r 45 | val daemon_version : t -> string OBus_property.r 46 | 47 | val properties : t -> OBus_property.group 48 | -------------------------------------------------------------------------------- /docs/man/obus-gen-client.1: -------------------------------------------------------------------------------- 1 | \" obus-gen-client.1 2 | \" ----------------- 3 | \" Copyright : (c) 2010, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | 7 | .TH OBUS-GEN-CLIENT 1 "April 2010" 8 | 9 | .SH NAME 10 | obus-gen-client \- generate client-side ocaml bindings from D-Bus introspection files 11 | 12 | .SH SYNOPSIS 13 | .B obus-gen-client 14 | [ 15 | .I options 16 | ] 17 | .I input-file 18 | 19 | .SH DESCRIPTION 20 | 21 | .B obus-gen-client 22 | generates an ocaml module from D-Bus introspection files. The 23 | generated module contains functions to send method calls, receive 24 | signals and read/write properties. It depends on the interface module 25 | generated with 26 | .B obus-gen-interface. 27 | 28 | The module generated by 29 | .B obus-gen-client 30 | it is meant to be edited. 31 | 32 | .SH OPTIONS 33 | 34 | .IP "-o output-prefix" 35 | Use this name as output prefix. It defaults to the input file name 36 | without its extension and extended with "_client". For example, if the 37 | input file name is "foo.xml" (or "foo.obus"), then "obus-gen-client" 38 | will generate "foo_client.ml" and "foo_client.mli". 39 | 40 | .IP "-keep-common" 41 | Keeps common interfaces, i.e. all interfaces starting with 42 | "org.freedesktop.DBus". By default they are dropped. 43 | 44 | .IP "-help or --help" 45 | Display a short usage summary and exit. 46 | 47 | .SH AUTHOR 48 | Jérémie Dimino 49 | 50 | .SH "SEE ALSO" 51 | .BR obus-introspect (1), 52 | .BR obus-gen-interface (1), 53 | .BR obus-gen-server (1). 54 | -------------------------------------------------------------------------------- /docs/man/obus-gen-server.1: -------------------------------------------------------------------------------- 1 | \" obus-gen-server.1 2 | \" ----------------- 3 | \" Copyright : (c) 2010, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | 7 | .TH OBUS-GEN-SERVER 1 "April 2010" 8 | 9 | .SH NAME 10 | obus-gen-server \- generate server-side ocaml bindings from D-Bus introspection files 11 | 12 | .SH SYNOPSIS 13 | .B obus-gen-server 14 | [ 15 | .I options 16 | ] 17 | .I input-files 18 | 19 | .SH DESCRIPTION 20 | 21 | .B obus-gen-server 22 | generates an ocaml module from D-Bus introspection files. The 23 | generated module contains code for defining a D-Bus service 24 | implementing the D-Bus interfaces listed in intropection files. It 25 | depends on the interface module generated with 26 | .B obus-gen-interface. 27 | 28 | The module generated by 29 | .B obus-gen-server 30 | it is meant to be edited. 31 | 32 | .SH OPTIONS 33 | 34 | .IP "-o output-prefix" 35 | Use this name as output prefix. It defaults to the input file name 36 | without its extension and extended with "_server". For example, if the 37 | input file name is "foo.xml" (or "foo.obus"), then "obus-gen-server" 38 | will generate "foo_server.ml" and "foo_server.mli". 39 | 40 | .IP "-keep-common" 41 | Keeps common interfaces, i.e. all interfaces starting with 42 | "org.freedesktop.DBus". By default they are dropped. 43 | 44 | .IP "-help or --help" 45 | Display a short usage summary and exit. 46 | 47 | .SH AUTHOR 48 | Jérémie Dimino 49 | 50 | .SH "SEE ALSO" 51 | .BR obus-introspect (1), 52 | .BR obus-gen-interface (1), 53 | .BR obus-gen-client (1). 54 | -------------------------------------------------------------------------------- /src/internals/oBus_path.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_path.mli 3 | * ------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Manipulation of dbus object paths *) 11 | 12 | type element = string 13 | (** A path component *) 14 | 15 | type t = element list 16 | (** A complete path *) 17 | 18 | val compare : t -> t -> int 19 | (** Same as [Stdlib.compare]. It allows this module to be used 20 | as argument to the functors [Set.Make] and [Map.Make]. *) 21 | 22 | (** {6 Construction} *) 23 | 24 | val empty : t 25 | (** Empty path *) 26 | 27 | val after : t -> t -> t option 28 | (** [after prefix path] if [path = prefix @ p] return [Some p], and 29 | [None] if not *) 30 | 31 | val of_string : string -> t 32 | (** Create an object path from a string. 33 | 34 | @raise OBus_string.Invalid_string if the given string does not 35 | represent a valid object path *) 36 | 37 | val to_string : t -> string 38 | (** Return a string representation of an object path *) 39 | 40 | (** {6 Helpers} *) 41 | 42 | val escape : string -> element 43 | (** Escape an arbitrary string into a valid element *) 44 | 45 | val unescape : element -> string 46 | (** Interpret escape sequence to get back the original string *) 47 | 48 | val generate : unit -> t 49 | (** [generate ()] generate a new unique path *) 50 | 51 | (** {6 Validation} *) 52 | 53 | val validate : OBus_string.validator 54 | val validate_element : OBus_string.validator 55 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009, Jeremie Dimino 2 | All rights reserved. 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | * Neither the name of Jeremie Dimino nor the names of his 12 | contributors may be used to endorse or promote products derived 13 | from this software without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY 16 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /tests/test_gc.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * test_gc.ml 3 | * ---------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | open Lwt_io 12 | 13 | let ok = ref false 14 | let finalise _ = ok := true 15 | 16 | let test () = 17 | let success = true in 18 | let%lwt bus = OBus_bus.session () in 19 | 20 | let%lwt () = print "safety check: " in 21 | let event = ref 0 in 22 | ok := false; 23 | Gc.finalise finalise event; 24 | let event = 1 in 25 | ignore event; 26 | Gc.full_major (); 27 | let%lwt () = printl (if !ok then "success" else "failure") in 28 | let success = success && !ok in 29 | 30 | let%lwt () = print "testing garbage collection of a signal without a switch: " in 31 | let%lwt event = OBus_signal.connect (OBus_bus.name_owner_changed bus) in 32 | ok := false; 33 | Gc.finalise finalise event; 34 | let event = 1 in 35 | ignore event; 36 | Gc.full_major (); 37 | let%lwt () = printl (if !ok then "success" else "failure") in 38 | let success = success && !ok in 39 | 40 | let%lwt () = print "testing garbage collection of a signal with a switch: " in 41 | let switch = Lwt_switch.create () in 42 | let%lwt event = OBus_signal.connect ~switch (OBus_bus.name_owner_changed bus) in 43 | ok := false; 44 | Gc.finalise finalise event; 45 | let event = 1 in 46 | ignore event; 47 | Gc.full_major (); 48 | let%lwt () = printl (if !ok then "success" else "failure") in 49 | let success = success && !ok in 50 | 51 | return success 52 | -------------------------------------------------------------------------------- /tests/test_validation.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * test_validation.ml 3 | * ------------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | open Lwt_io 12 | 13 | let good = [ 14 | OBus_string.validate "azerty"; 15 | OBus_string.validate "Jérémie"; 16 | 17 | OBus_path.validate "/"; 18 | OBus_path.validate "/a"; 19 | OBus_path.validate "/a/b"; 20 | 21 | OBus_name.validate_bus ":1.1"; 22 | OBus_name.validate_bus ":a.2"; 23 | OBus_name.validate_bus "foo.bar"; 24 | OBus_name.validate_bus "a.b.c.d"; 25 | ] 26 | 27 | let bad = [ 28 | OBus_string.validate "\xe9"; 29 | 30 | OBus_path.validate "/dd//dd"; 31 | OBus_path.validate "/dd//"; 32 | OBus_path.validate "/dd/"; 33 | OBus_path.validate ""; 34 | 35 | OBus_name.validate_bus ":1..2"; 36 | OBus_name.validate_bus "a..b"; 37 | ] 38 | 39 | let test () = 40 | let%lwt () = printl "Validation of all types of D-Bus strings" in 41 | let%lwt () = 42 | Lwt_list.iter_s 43 | (function 44 | | Some err -> 45 | printlf "valid string recognized as bad: %s" (OBus_string.error_message err) 46 | | None -> 47 | return ()) 48 | good 49 | in 50 | let%lwt () = 51 | Lwt_list.iter_s 52 | (function 53 | | None -> 54 | printlf "invalid string recognized as good" 55 | | Some _ -> 56 | return ()) 57 | bad 58 | in 59 | return (List.for_all ((=) None) good && List.for_all ((<>) None) bad) 60 | -------------------------------------------------------------------------------- /bindings/upower/uPower_wakeups.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_wakeups.ml 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | type data = { 13 | data_is_userspace : bool; 14 | data_id : int; 15 | data_value : float; 16 | data_cmdline : string option; 17 | data_details : string; 18 | } 19 | 20 | open UPower_interfaces.Org_freedesktop_UPower_Wakeups 21 | 22 | let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Wakeups"] 23 | 24 | let has_capability daemon = 25 | OBus_property.make p_HasCapability (proxy daemon) 26 | 27 | let get_total daemon = 28 | let%lwt value = OBus_method.call m_GetTotal (proxy daemon) () in 29 | let value = Int32.to_int value in 30 | return value 31 | 32 | let total_changed daemon = 33 | OBus_signal.map 34 | (fun value -> 35 | let value = Int32.to_int value in 36 | value) 37 | (OBus_signal.make s_TotalChanged (proxy daemon)) 38 | 39 | let get_data daemon = 40 | let%lwt data = OBus_method.call m_GetData (proxy daemon) () in 41 | return 42 | (List.map 43 | (fun (is_userspace, id, value, cmdline, details) -> { 44 | data_is_userspace = is_userspace; 45 | data_id = Int32.to_int id; 46 | data_value = value; 47 | data_cmdline = if cmdline = "" then None else Some cmdline; 48 | data_details = details; 49 | }) 50 | data) 51 | 52 | let data_changed daemon = 53 | OBus_signal.make s_DataChanged (proxy daemon) 54 | -------------------------------------------------------------------------------- /bindings/udisks/uDisks_expander.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uDisks_expander.ml 3 | * ------------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | include OBus_proxy.Private 11 | 12 | open UDisks_interfaces.Org_freedesktop_UDisks_Expander 13 | 14 | let changed proxy = 15 | OBus_signal.make s_Changed proxy 16 | 17 | let native_path proxy = 18 | OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy 19 | 20 | let vendor proxy = 21 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy 22 | 23 | let model proxy = 24 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy 25 | 26 | let revision proxy = 27 | OBus_property.make ~monitor:UDisks_monitor.monitor p_Revision proxy 28 | 29 | let num_ports proxy = 30 | OBus_property.map_r 31 | (fun x -> Int32.to_int x) 32 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy) 33 | 34 | let upstream_ports proxy = 35 | OBus_property.map_r_with_context 36 | (fun context x -> List.map (fun path -> UDisks_port.of_proxy ( OBus_proxy.make (OBus_context.sender context) path)) x) 37 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_UpstreamPorts proxy) 38 | 39 | let adapter proxy = 40 | OBus_property.map_r_with_context 41 | (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) 42 | (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy) 43 | 44 | let properties proxy = 45 | OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface 46 | -------------------------------------------------------------------------------- /examples/network_manager.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * network_manager.ml 3 | * ------------------ 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* This example illustrate the use of OBus to detect network-manager 11 | connections. *) 12 | 13 | open Lwt_react 14 | open Lwt 15 | open Lwt_io 16 | open OBus_value 17 | 18 | let () = Lwt_main.run begin 19 | (* Get the manager. *) 20 | let%lwt manager = Nm_manager.daemon () in 21 | 22 | (* Create a signal descriptor for listenning on signals comming from 23 | any DHCP4 object. *) 24 | let sig_desc = 25 | OBus_signal.make_any 26 | Nm_interfaces.Org_freedesktop_NetworkManager_DHCP4Config.s_PropertiesChanged 27 | (Nm_manager.to_peer manager) 28 | in 29 | 30 | (* Connects to this signal. *) 31 | let%lwt event = OBus_signal.connect sig_desc in 32 | 33 | (* Prints all DHCP4 options when one configuration changes. *) 34 | E.keep 35 | (E.map_s 36 | (fun (proxy, properties) -> 37 | match try Some(List.assoc "Options" properties) with Not_found -> None with 38 | | Some options -> 39 | let%lwt () = printlf "DHCP options for %S:" (OBus_path.to_string (OBus_proxy.path proxy)) in 40 | Lwt_list.iter_s 41 | (fun (key, value) -> 42 | printlf " %s = %s" key (V.string_of_single value)) 43 | (C.cast_single (C.dict C.string C.variant) options) 44 | | None -> 45 | return ()) 46 | event); 47 | 48 | fst (wait ()) 49 | end 50 | -------------------------------------------------------------------------------- /src/internals/oBus_introspect.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_introspect.mli 3 | * ------------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** D-Bus obejct introspection *) 11 | 12 | type name = string 13 | 14 | type annotation = name * string 15 | type argument = name option * OBus_value.T.single 16 | 17 | type access = Read | Write | Read_write 18 | (** Access mode of properties *) 19 | 20 | type member = 21 | | Method of name * argument list * argument list * annotation list 22 | | Signal of name * argument list * annotation list 23 | | Property of name * OBus_value.T.single * access * annotation list 24 | 25 | type interface = name * member list * annotation list 26 | type node = OBus_path.element 27 | 28 | type document = interface list * node list 29 | 30 | (** {6 Xml conversion} *) 31 | 32 | exception Parse_failure of Xmlm.pos * string 33 | 34 | val input : Xmlm.input -> document 35 | (** Try to read an xml document as an introspection document. 36 | 37 | @raise Parse_failure if the parsing fail. *) 38 | 39 | val output : Xmlm.output -> document -> unit 40 | (** Create an xml from an introspection document *) 41 | 42 | (** {6 Well-known annotations} *) 43 | 44 | val deprecated : name 45 | (** The [org.freedesktop.DBus.Deprecated] annotation *) 46 | 47 | val csymbol : name 48 | (** The [org.freedesktop.DBus.GLib.CSymbol] annotation *) 49 | 50 | val no_reply : name 51 | (** The [org.freedesktop.DBus.Method.NoReply] annotation *) 52 | 53 | val emits_changed_signal : name 54 | (** The [org.freedesktop.DBus.Property.EmitsChangedSignal] annotation *) 55 | -------------------------------------------------------------------------------- /src/protocol/oBus_method.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_method.ml 3 | * -------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let section = Lwt_log.Section.make "obus(method)" 11 | 12 | let call info proxy args = 13 | OBus_connection.method_call 14 | ~connection:(OBus_proxy.connection proxy) 15 | ~destination:(OBus_proxy.name proxy) 16 | ~path:(OBus_proxy.path proxy) 17 | ~interface:(OBus_member.Method.interface info) 18 | ~member:(OBus_member.Method.member info) 19 | ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info)) 20 | ~o_args:(OBus_value.arg_types (OBus_member.Method.o_args info)) 21 | args 22 | 23 | let call_with_context info proxy args = 24 | let%lwt msg, result = 25 | OBus_connection.method_call_with_message 26 | ~connection:(OBus_proxy.connection proxy) 27 | ~destination:(OBus_proxy.name proxy) 28 | ~path:(OBus_proxy.path proxy) 29 | ~interface:(OBus_member.Method.interface info) 30 | ~member:(OBus_member.Method.member info) 31 | ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info)) 32 | ~o_args:(OBus_value.arg_types (OBus_member.Method.o_args info)) 33 | args 34 | in 35 | Lwt.return (OBus_context.make (OBus_proxy.connection proxy) msg, result) 36 | 37 | let call_no_reply info proxy args = 38 | OBus_connection.method_call_no_reply 39 | ~connection:(OBus_proxy.connection proxy) 40 | ~destination:(OBus_proxy.name proxy) 41 | ~path:(OBus_proxy.path proxy) 42 | ~interface:(OBus_member.Method.interface info) 43 | ~member:(OBus_member.Method.member info) 44 | ~i_args:(OBus_value.arg_types (OBus_member.Method.i_args info)) 45 | args 46 | -------------------------------------------------------------------------------- /src/protocol/oBus_match_rule_lexer.mll: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_match_rule_lexer.mll 3 | * ------------------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | { 11 | exception Fail of int * string 12 | 13 | let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum 14 | 15 | let fail lexbuf fmt = 16 | Printf.ksprintf 17 | (fun msg -> raise (Fail(pos lexbuf, msg))) 18 | fmt 19 | } 20 | 21 | rule match_rules = parse 22 | | (['a'-'z' '_' '0'-'9']+ as key) "='" ([^ '\'']* as value) '\'' 23 | { if comma lexbuf then 24 | (pos lexbuf, key, value) :: match_rules lexbuf 25 | else begin 26 | check_eof lexbuf; 27 | [(pos lexbuf, key, value)] 28 | end } 29 | | "=" { 30 | fail lexbuf "empty key" 31 | } 32 | | eof { 33 | fail lexbuf "match rule expected" 34 | } 35 | | _ as ch { 36 | fail lexbuf "invalid character %C" ch 37 | } 38 | 39 | and comma = parse 40 | | ',' { true } 41 | | "" { false } 42 | 43 | and check_eof = parse 44 | | eof { () } 45 | | _ as ch { fail lexbuf "invalid character %C" ch } 46 | 47 | and arg = parse 48 | | "arg" (['0'-'9']+ as n) (("" | "path" | "namespace") as kind) eof { 49 | let n = int_of_string n in 50 | if n >= 0 && n <= 63 then 51 | Some(n, 52 | match kind with 53 | | "" -> `String 54 | | "path" -> `Path 55 | | "namespace" -> `Namespace 56 | | _ -> assert false) 57 | else 58 | fail lexbuf "invalid argument number '%d': it must be between 0 and 63" n 59 | } 60 | | "" { None } 61 | -------------------------------------------------------------------------------- /tools/tools_util/utils.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * utils.mli 3 | * --------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Utilities for tools *) 11 | 12 | module IFSet : Set.S with type elt = OBus_introspect_ext.interface 13 | (** Set of interfaces *) 14 | 15 | val parse_xml : string -> IFSet.t 16 | (** [parse_xml file_name] parses [file_name] as an XML introspection 17 | file *) 18 | 19 | val parse_idl : string -> IFSet.t 20 | (** [parse_xml file_name] parses [file_name] as an obus IDL file *) 21 | 22 | val parse_file : string -> IFSet.t 23 | (** [parse_file file_name] parses [file_name] as an XML 24 | introspection file or as an IDL file (according to the file name 25 | extension), and returns the set of interfaces it contains. *) 26 | 27 | val file_name_of_interface_name : OBus_name.interface -> string 28 | (** Convert an interface name into a valid module file name *) 29 | 30 | val convertor_send : bool -> OBus_introspect_ext.term -> string option 31 | (** [convertor_send paren typ] returns an expression which convert 32 | caml values before they are sent. It returns [None] if no 33 | conversion is needed. If [paren] is [true] then no parenthesis 34 | will be used, otherwise the expression may be surrounded by 35 | parenthesis if needed *) 36 | 37 | val convertor_recv : bool -> OBus_introspect_ext.term -> string option 38 | (** [convertor_recv paren typ] returns an expression which convert 39 | caml values after they are received. It returns [None] if no 40 | conversion is needed. *) 41 | 42 | val make_annotation : OBus_introspect.name -> string 43 | (** [make_annotation name] returns the code for the given annotation *) 44 | -------------------------------------------------------------------------------- /bindings/upower/uPower_policy.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_policy.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Quality of service policy *) 11 | 12 | (** {6 Types} *) 13 | 14 | type cookie 15 | (** Type of request identifiers *) 16 | 17 | type latency = [ `Cpu_dma | `Network ] 18 | (** Type of latency request *) 19 | 20 | type latency_request = { 21 | lr_cookie : cookie; 22 | (** The random cookie that identifies the request. *) 23 | 24 | lr_uid : int; 25 | (** The user ID that issued the request. *) 26 | 27 | lr_pid : int; 28 | (** The process ID of the application. *) 29 | 30 | lr_exec : string; 31 | (** The executable that issued the request. *) 32 | 33 | lr_timespec : int64; 34 | (** The number of seconds since the epoch. *) 35 | 36 | lr_persistent : bool; 37 | (** If the request is persistent and outlives the connection lifetime. *) 38 | 39 | lr_typ : latency; 40 | (** The type of the request.*) 41 | 42 | lr_reserved : string; 43 | 44 | lr_value : int; 45 | (** The value, in microseconds or kilobits per second. *) 46 | } 47 | 48 | (** {6 Methods} *) 49 | 50 | val get_latency_requests : UPower.t -> latency_request list Lwt.t 51 | val get_latency : UPower.t -> latency : latency -> int Lwt.t 52 | 53 | val request_latency : UPower.t -> latency : latency -> value : int -> persistent : bool -> cookie Lwt.t 54 | val cancel_request : UPower.t -> latency : latency -> cookie : cookie -> unit Lwt.t 55 | 56 | val set_minimum_latency : UPower.t -> latency : latency -> value : int -> unit Lwt.t 57 | 58 | (** {6 Signals} *) 59 | 60 | val requests_changed : UPower.t -> unit OBus_signal.t 61 | val latency_changed : UPower.t -> (latency * int) OBus_signal.t 62 | -------------------------------------------------------------------------------- /docs/man/obus-gen-interface.1: -------------------------------------------------------------------------------- 1 | \" obus-gen-interface.1 2 | \" -------------------- 3 | \" Copyright : (c) 2010, Jeremie Dimino 4 | \" Licence : BSD3 5 | \" 6 | \" This file is a part of obus, an ocaml implementation of D-Bus. 7 | 8 | .TH OBUS-GEN-INTERFACE 1 "April 2010" 9 | 10 | .SH NAME 11 | obus-gen-interface \- convert D-Bus introspection files to ocaml code 12 | 13 | .SH SYNOPSIS 14 | .B obus-gen-interface 15 | [ 16 | .I options 17 | ] 18 | .I input-file 19 | 20 | .SH DESCRIPTION 21 | 22 | .B obus-gen-interface 23 | generates an OCaml module from a D-Bus introspection file. The 24 | generated module contains methods, signals and properties 25 | definitions. It is required for by both client-side and server-side 26 | code. 27 | 28 | Note that the files generated by 29 | .B obus-gen-interface 30 | are not meant to be edited. 31 | 32 | .SH OPTIONS 33 | 34 | .IP "-o output-prefix" 35 | Use this name as output prefix. It defaults to the input file name 36 | without its extension and extended with "_interfaces". For example, if 37 | the input file name is "foo.xml" (or "foo.obus"), then 38 | "obus-gen-interface" will generate "foo_interfaces.ml" and 39 | "foo_interfaces.mli". 40 | 41 | .IP "-keep-common" 42 | Keeps common interfaces, i.e. all interfaces starting with 43 | "org.freedesktop.DBus". By default they are dropped. 44 | 45 | .IP "-mode {both|client|server}" 46 | Set the code generation mode. It defaults to "both". In "client" mode, 47 | only code for client-side use is generated. In "server" mode, only 48 | code for server-side use is generated. In "both" mode, code for 49 | client-side and server-side use is generated. 50 | 51 | .IP "-help or --help" 52 | Display a short usage summary and exit. 53 | 54 | .SH AUTHOR 55 | Jérémie Dimino 56 | 57 | .SH "SEE ALSO" 58 | .BR obus-introspect (1), 59 | .BR obus-gen-client (1), 60 | .BR obus-gen-server (1). 61 | -------------------------------------------------------------------------------- /src/internals/oBus_string.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_string.mli 3 | * --------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Restriction on strings used with D-Bus *) 11 | 12 | (** There are a lot of restrictions for strings used in D-Bus. 13 | OBus only verifies strings when a message is sent or received *) 14 | 15 | type error = { 16 | (** Contains informations about invalid strings *) 17 | 18 | typ : string; 19 | (** Type of string ("string", "bus name", "error name", "path", 20 | ...) *) 21 | 22 | str : string; 23 | (** The string which fail to validate *) 24 | 25 | ofs : int; 26 | (** is the position in bytes where the validation failed *) 27 | 28 | msg : string; 29 | (** explains why the string failed to validate *) 30 | } 31 | 32 | val error_message : error -> string 33 | (** [error_message error] returns a human-readable error message *) 34 | 35 | (** {8 Error projections} *) 36 | 37 | val typ : error -> string 38 | val str : error -> string 39 | val ofs : error -> int 40 | val msg : error -> string 41 | 42 | (** {6 Validators} *) 43 | 44 | type validator = string -> error option 45 | (** Tests if a string is correct. 46 | 47 | - if it is, returns [None] 48 | - if not, returns [Some(ofs, msg)] *) 49 | 50 | exception Invalid_string of error 51 | 52 | val assert_validate : validator -> string -> unit 53 | (** Raises {!Invalid_string} if the given string failed to 54 | validate *) 55 | 56 | (** {6 Common strings} *) 57 | 58 | type t = string 59 | (** Type for common strings, restrictions are: 60 | 61 | - a string must be encoded in valid UTF-8 62 | - a string must not contains the null byte *) 63 | 64 | val validate : validator 65 | (** Validation function for common strings *) 66 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 1.2.5 (2024-02-27) 2 | ------------------ 3 | 4 | * Add OCaml >= 5.0 support 5 | * Upgrade to ppxlib >= 0.26.0 6 | 7 | 1.2.0 (2019-07-04) 8 | ------------------ 9 | 10 | * opam: add dependency on `menhir`, `ppxlib` 11 | * opam: remove dependency on `camlp4`, `lwt_camlp4` 12 | * switch to dune build system 13 | * replace Camlp4-based parser with the one generated by Menhir 14 | * remove all Camlp4 dependencies 15 | * replace Camlp4-based syntax module with obus.ppx 16 | 17 | 1.1.8 (2018-06-02) 18 | ------------------ 19 | 20 | * opam: add dependency on `oasis`, `lwt_react`, `lwt_camlp4`, `lwt_log` 21 | * opam: `ocamlfind` is now a build dependency 22 | * add support for OCaml 4.06 and `lwt` 3 23 | * bump minimum OCaml version to 4.02.3 24 | * enable travis tests 25 | * fix missing signature validation 26 | 27 | 1.1.7 (2016-07-18) 28 | ------------------ 29 | 30 | * fix compatibility with OCaml 4.03.0 31 | 32 | 1.1.6 (2014-04-21) 33 | ------------------ 34 | 35 | * support for React 1.0.0 36 | 37 | 1.1.5 (2012-10-02) 38 | ------------------ 39 | 40 | * compatibility fix for type-conv 41 | 42 | 1.1.4 (2012-07-30) 43 | ------------------ 44 | 45 | * update oasis files 46 | * minor fixes 47 | 48 | 1.1.3 (2011-07-29) 49 | ------------------ 50 | 51 | * depends on type-conv instead of type-conv.syntax 52 | * implements version 0.18 of the specification: 53 | * add the `eavesdrop` match keyword 54 | 55 | 1.1.2 (2011-04-12) 56 | ------------------ 57 | 58 | * implement property monitoring for upower, udisks and network-manager 59 | * implement new D-Bus errors (UnknownObject, UnknownInterface, ...) 60 | * update and implement new argument filters (argNpath and argNnamespace) 61 | 62 | 1.1.1 (2011-02-14) 63 | ------------------ 64 | 65 | * Fix a race condition in servers that may causes authentication to hang 66 | * Add support for launchd addresses 67 | 68 | 1.1 (2010-12-13) 69 | ---------------- 70 | 71 | * First stable release 72 | -------------------------------------------------------------------------------- /examples/bus_functions.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * bus_functions.ml 3 | * ---------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* This sample illustrate use if some of the functions offered by the 11 | message bus *) 12 | 13 | open Lwt 14 | open Lwt_react 15 | open Lwt_io 16 | 17 | let service = "org.freedesktop.Notifications" 18 | let name = "org.ocamlcore.forge.obus" 19 | 20 | module String_set = Set.Make(String) 21 | 22 | let () = Lwt_main.run begin 23 | let%lwt bus = OBus_bus.session () in 24 | 25 | let%lwt id = OBus_bus.get_id bus in 26 | let%lwt () = printlf "the message bus id is: %S" (OBus_uuid.to_string id) in 27 | 28 | let%lwt names = OBus_bus.list_names bus in 29 | let%lwt () = printlf "names on the session bus:" in 30 | let%lwt () = Lwt_list.iter_p (printlf " %s") names in 31 | 32 | let%lwt names = OBus_bus.list_activatable_names bus in 33 | let%lwt () = printlf "these names are activatable:" in 34 | let%lwt () = Lwt_list.iter_p (printlf " %s") names in 35 | 36 | let%lwt () = printf "trying to start service %S: " service in 37 | let%lwt result = OBus_bus.start_service_by_name bus service in 38 | let%lwt () = printl 39 | (match result with 40 | | `Success -> "success" 41 | | `Already_running -> "already running") 42 | in 43 | 44 | let%lwt () = printf "trying to acquire the name %S: " name in 45 | let%lwt result = OBus_bus.request_name bus ~replace_existing:true ~do_not_queue:true name in 46 | let%lwt () = printl 47 | (match result with 48 | | `Primary_owner -> "success" 49 | | `In_queue -> "in queue" 50 | | `Exists -> "the name already exists" 51 | | `Already_owner -> "i already own the name") 52 | in 53 | 54 | printlf "my names are: %s" (String.concat ", " (String_set.elements (S.value (OBus_bus.names bus)))) 55 | end 56 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_access_point.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_access_point.mli 3 | * ------------------- 4 | * Copyright : (c) 2010, Pierre Chambart 5 | * 2010, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | (** Access point interface *) 12 | 13 | include OBus_proxy.Private 14 | 15 | (** {6 Signals} *) 16 | 17 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 18 | 19 | (** {6 Properties} *) 20 | 21 | type ap_flag = 22 | [ `Privacy (** Access point supports privacy measures. *) ] 23 | 24 | val flags : t -> ap_flag list OBus_property.r 25 | 26 | type ap_security_flag = 27 | [ `Pair_wep40 28 | (** Access point supports pairwise 40-bit WEP encryption *) 29 | | `Pair_wep104 30 | (** Access point supports pairwise 104-bit WEP encryption *) 31 | | `Pair_tkip 32 | (** Access point supports pairwise TKIP encryption *) 33 | | `Pair_ccmp 34 | (** Access point supports pairwise CCMP encryption *) 35 | | `Group_wep40 36 | (** Access point supports a group 40-bit WEP cipher *) 37 | | `Group_wep104 38 | (** Access point supports a group 104-bit WEP cipher *) 39 | | `Group_tkip 40 | (** Access point supports a group TKIP cipher *) 41 | | `Group_ccmp 42 | (** Access point supports a group CCMP cipher *) 43 | | `Key_mgmt_psk 44 | (** Access point supports PSK key management *) 45 | | `Key_mgmt_802_1x 46 | (** Access point supports 802.1x key management *) ] 47 | 48 | val wpa_flags : t -> ap_security_flag list OBus_property.r 49 | val rsn_flags : t -> ap_security_flag list OBus_property.r 50 | 51 | val ssid : t -> string OBus_property.r 52 | 53 | val frequency : t -> int OBus_property.r 54 | val hw_address : t -> string OBus_property.r 55 | val mode : t -> int OBus_property.r 56 | val max_bitrate : t -> int OBus_property.r 57 | val strength : t -> int OBus_property.r 58 | 59 | val properties : t -> OBus_property.group 60 | -------------------------------------------------------------------------------- /src/protocol/oBus_address.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_address.mli 3 | * ---------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Manipulation of D-Bus addresses *) 11 | 12 | (** {6 Types} *) 13 | 14 | type guid = OBus_uuid.t 15 | (** A unique address identifier. Each server's listening address 16 | has a unique one. *) 17 | 18 | (** Type of an address *) 19 | type t = { 20 | name : string; 21 | (** The transport name *) 22 | 23 | args : (string * string) list; 24 | (** Arguments of the address *) 25 | } 26 | 27 | val name : t -> string 28 | (** [name] projection *) 29 | 30 | val args : t -> (string * string) list 31 | (** [args] Projection *) 32 | 33 | val make : name : string -> args : (string * string) list -> t 34 | (** Creates an address *) 35 | 36 | val arg : string -> t -> string option 37 | (** [arg key address] returns the value of argument [key], if any *) 38 | 39 | val guid : t -> guid option 40 | (** Returns the address guid, if any *) 41 | 42 | (** {6 To/from string conversion} *) 43 | 44 | exception Parse_failure of string * int * string 45 | (** [Parse_failure(string, position, reason)] exception raised when 46 | parsing a string failed. *) 47 | 48 | val of_string : string -> t list 49 | (** [of_string str] parse [str] and return the list of addresses 50 | defined in it. 51 | 52 | @raise Parse_failure if the string contains an invalid address 53 | *) 54 | 55 | val to_string : t list -> string 56 | (** [to_string addresses] return a string representation of a list 57 | of addresses *) 58 | 59 | (** {6 Well-known addresses} *) 60 | 61 | val system : t list Lwt.t Lazy.t 62 | (** The list of addresses for system bus *) 63 | 64 | val session : t list Lwt.t Lazy.t 65 | (** The list of addresses for session bus *) 66 | 67 | val default_system : t list 68 | (** The default addresses for the system bus *) 69 | 70 | val default_session : t list 71 | (** The default addresses for the session bus *) 72 | -------------------------------------------------------------------------------- /utils/scripts/multimedia-keys: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocamlscript 2 | (* 3 | * multimedia-keys 4 | * --------------- 5 | * Copyright : (c) 2009, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | Ocaml.packs := ["lwt.syntax"; "obus.syntax"; "obus"] 12 | -- 13 | 14 | (* Simple script which listen keyboard events emited by hal and run 15 | commands *) 16 | 17 | open Lwt 18 | 19 | (* Configuration *) 20 | let commands = [ 21 | ("volume-up", "amixer -q set Master 5%+"); 22 | ("volume-down", "amixer -q set Master 5%-"); 23 | ] 24 | 25 | lwt () = 26 | lwt bus = Lazy.force OBus_bus.system in 27 | 28 | (* Tell the message bus we want to receive ButtonPressed events from 29 | hal. *) 30 | lwt () = OBus_bus.add_match bus (OBus_match.rule 31 | ~sender:"org.freedesktop.Hal" 32 | ~interface:"org.freedesktop.Hal.Device" 33 | ~member:"Condition" 34 | ~arguments:[(0, "ButtonPressed")] ()) in 35 | 36 | (* Add a message filter. We use that instead of adding a signal 37 | receiver because we do not care about which object send the 38 | event. *) 39 | ignore (Lwt_sequence.add_l 40 | (function 41 | | { OBus_message.typ = OBus_message.Signal(_, "org.freedesktop.Hal.Device", "Condition"); 42 | OBus_message.body = OBus_value.V.([Basic(String "ButtonPressed"); Basic(String button)]) } -> 43 | begin match try Some(List.assoc button commands) with Not_found -> None with 44 | | Some command -> 45 | ignore_result (Lwt_unix.system command) 46 | | None -> 47 | () 48 | end; 49 | Some msg 50 | | msg -> 51 | Some msg) 52 | (OBus_connection.incoming_filters bus)); 53 | 54 | (* Wait forever, the program will exit when the connection is 55 | closed *) 56 | fst (wait ()) 57 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_settings.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_settings.mli 3 | * --------------- 4 | * Copyright : (c) 2010, Pierre Chambart 5 | * 2010, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | (** NetworkManager settings *) 12 | 13 | include OBus_proxy.Private 14 | 15 | val user : unit -> t Lwt.t 16 | (** [user ()] returns the proxy object for user settings. The object 17 | is on the session message bus. *) 18 | 19 | val system : unit -> t Lwt.t 20 | (** [system ()] returns the proxy object for system settings. The 21 | object is on the system message bus *) 22 | 23 | (** Connection settings *) 24 | module Connection : sig 25 | include OBus_proxy.Private 26 | 27 | (** {6 Methods} *) 28 | 29 | val update : t -> properties : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t 30 | val delete : t -> unit Lwt.t 31 | val get_settings : t -> (string * (string * OBus_value.V.single) list) list Lwt.t 32 | 33 | (** {6 Signals} *) 34 | 35 | val updated : t -> (string * (string * OBus_value.V.single) list) list OBus_signal.t 36 | val removed : t -> unit OBus_signal.t 37 | 38 | module Secrets : sig 39 | val get_secrets : t -> setting_name : string -> hints : string list -> request_new : bool -> (string * (string * OBus_value.V.single) list) list Lwt.t 40 | end 41 | end 42 | 43 | (** System settings *) 44 | module System : sig 45 | val save_hostname : t -> hostname : string -> unit Lwt.t 46 | val hostname : t -> string OBus_property.r 47 | val can_modify : t -> bool OBus_property.r 48 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 49 | val check_permissions : t -> unit OBus_signal.t 50 | val get_permissions : t -> int Lwt.t 51 | end 52 | 53 | (** {6 Methods} *) 54 | 55 | val list_connections : t -> Connection.t list Lwt.t 56 | 57 | (** {6 Signals} *) 58 | 59 | val add_connection : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t 60 | val new_connection : t -> Connection.t OBus_signal.t 61 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_manager.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_manager.mli 3 | * -------------- 4 | * Copyright : (c) 2010, Pierre Chambart 5 | * 2010, Jeremie Dimino 6 | * Licence : BSD3 7 | * 8 | * This file is a part of obus, an ocaml implementation of D-Bus. 9 | *) 10 | 11 | (** NetworkManager main interface *) 12 | 13 | include OBus_peer.Private 14 | 15 | val daemon : unit -> t Lwt.t 16 | (** [daemon ()] returns the peer object for the network manager daemon *) 17 | 18 | (** {6 Types} *) 19 | 20 | (** State of the daemon *) 21 | type state = 22 | [ `Unknown 23 | (** The NetworkManager daemon is in an unknown state. *) 24 | | `Asleep 25 | (** The NetworkManager daemon is asleep and all interfaces 26 | managed by it are inactive. *) 27 | | `Connecting 28 | (** The NetworkManager daemon is connecting a device. *) 29 | | `Connected 30 | (** The NetworkManager daemon is connected. *) 31 | | `Disconnected 32 | (** The NetworkManager daemon is disconnected. *) ] 33 | 34 | (** {6 Methods} *) 35 | 36 | val get_devices : t -> Nm_device.t list Lwt.t 37 | val activate_connection : t -> 38 | service_name : OBus_name.bus -> 39 | connection : Nm_settings.Connection.t -> 40 | device : Nm_device.t -> 41 | specific_object : OBus_proxy.t -> 42 | Nm_connection.t Lwt.t 43 | val deactivate_connection : t -> active_connection : Nm_connection.t -> unit Lwt.t 44 | val sleep : t -> sleep : bool -> unit Lwt.t 45 | 46 | (** {6 Signals} *) 47 | 48 | val state_changed : t -> state OBus_signal.t 49 | val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t 50 | val device_added : t -> Nm_device.t OBus_signal.t 51 | val device_removed : t -> Nm_device.t OBus_signal.t 52 | 53 | (** {6 Properties} *) 54 | 55 | val wireless_enabled : t -> bool OBus_property.rw 56 | val wireless_hardware_enabled : t -> bool OBus_property.r 57 | val wwan_enabled : t -> bool OBus_property.rw 58 | val wwan_hardware_enabled : t -> bool OBus_property.r 59 | val active_connections : t -> Nm_connection.t list OBus_property.r 60 | val state : t -> state OBus_property.r 61 | 62 | val properties : t -> OBus_property.group 63 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_connection.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_connection.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | open Lwt 9 | 10 | let section = Lwt_log.Section.make "network-manager(connection)" 11 | 12 | include OBus_proxy.Private 13 | 14 | open Nm_interfaces.Org_freedesktop_NetworkManager_Connection_Active 15 | 16 | type state = 17 | [ `Unknown 18 | | `Activating 19 | | `Activated ] 20 | 21 | let service_name proxy = 22 | OBus_property.make ~monitor:Nm_monitor.monitor p_ServiceName proxy 23 | 24 | let connection proxy = 25 | OBus_property.map_r_with_context 26 | (fun context x -> 27 | Nm_settings.Connection.of_proxy 28 | (OBus_proxy.make (OBus_context.sender context) x)) 29 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Connection proxy) 30 | 31 | let specific_object proxy = 32 | OBus_property.map_r_with_context 33 | (fun context x -> OBus_proxy.make (OBus_context.sender context) x) 34 | (OBus_property.make ~monitor:Nm_monitor.monitor p_SpecificObject proxy) 35 | 36 | let devices proxy = 37 | OBus_property.map_r_with_context 38 | (fun context paths -> 39 | List.map 40 | (fun path -> 41 | Nm_device.of_proxy 42 | (OBus_proxy.make (OBus_context.sender context) path)) 43 | paths) 44 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Devices proxy) 45 | 46 | let state proxy = 47 | OBus_property.map_r 48 | (function 49 | | 0l -> `Unknown 50 | | 1l -> `Activating 51 | | 2l -> `Activated 52 | | st -> 53 | ignore (Lwt_log.warning_f ~section "Nm_connection.state: unknown state: %ld" st); 54 | `Unknown) 55 | (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy) 56 | 57 | let default proxy = 58 | OBus_property.make ~monitor:Nm_monitor.monitor p_Default proxy 59 | 60 | let vpn proxy = 61 | OBus_property.make ~monitor:Nm_monitor.monitor p_Vpn proxy 62 | 63 | let properties_changed proxy = 64 | OBus_signal.make s_PropertiesChanged proxy 65 | 66 | let properties proxy = 67 | OBus_property.group ~monitor:Nm_monitor.monitor proxy interface 68 | -------------------------------------------------------------------------------- /src/idl/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Lexing 3 | open Parser 4 | 5 | exception SyntaxError of string 6 | 7 | } 8 | 9 | let lident = ['a'-'z']['a'-'z''0'-'9''_']* 10 | 11 | let uident = ['A'-'Z']['a'-'z''A'-'Z''0'-'9''_']* 12 | 13 | let integer = ('0'['b''o''x''u'])?['0'-'9']+ 14 | 15 | rule read = 16 | parse 17 | | [' ' '\t' '\n']+ { read lexbuf } 18 | | "interface" { INTERFACE } 19 | | "method" { METHOD } 20 | | "signal" { SIGNAL } 21 | | "property_r" { PROPERTY_R } 22 | | "property_w" { PROPERTY_W } 23 | | "property_rw" { PROPERTY_RW } 24 | | "annotation" { ANNOTATION } 25 | | "enum" { ENUM } 26 | | "flag" { FLAG } 27 | | "with" { WITH } 28 | | '"' { read_string (Buffer.create 20) lexbuf } 29 | | "(*" { skip_comment lexbuf } 30 | | "," { COMMA } 31 | | "." { PERIOD } 32 | | "=" { EQMARK } 33 | | ":" { COLON } 34 | | "+" { PLUS } 35 | | "-" { MINUS } 36 | | "*" { STAR } 37 | | "->" { ARROW } 38 | | "_" { UNDERSCORE } 39 | | "{" { LBRACE } 40 | | "}" { RBRACE } 41 | | "(" { LPAREN } 42 | | ")" { RPAREN } 43 | | integer as i { INT i } 44 | | lident as s { LIDENT s } 45 | | uident as s { UIDENT s } 46 | | _ { raise (SyntaxError ("Unexpected char: " ^ Lexing.lexeme lexbuf)) } 47 | | eof { EOF } 48 | 49 | and skip_comment = 50 | parse 51 | | "*)" { read lexbuf } 52 | | _ { skip_comment lexbuf } 53 | 54 | and read_string buf = 55 | parse 56 | | '"' { STRING (Buffer.contents buf) } 57 | | '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf } 58 | | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } 59 | | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } 60 | | '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf } 61 | | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } 62 | | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } 63 | | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } 64 | | [^ '"' '\\']+ 65 | { Buffer.add_string buf (Lexing.lexeme lexbuf); 66 | read_string buf lexbuf 67 | } 68 | | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) } 69 | | eof { raise (SyntaxError ("String is not terminated")) } 70 | -------------------------------------------------------------------------------- /tests/main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * main.ml 3 | * ------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | let tty = Unix.isatty Unix.stdout 13 | 14 | let title msg = 15 | if tty then 16 | Lwt_io.printf "\027[34;1m%s\r=[ \027[37;1m%s\027[34;1m ]=\n\027[0m" (String.make 80 '=') msg 17 | else 18 | Lwt_io.printlf "=[ %s ]=" msg 19 | 20 | let rec run_tests failures total = function 21 | | [] -> 22 | if tty then 23 | if failures = 0 then 24 | Lwt_io.printl "\027[32;1mAll tests succeeded!\027[0m" 25 | else 26 | Lwt_io.printlf "\027[31;1m%d of %d tests failed.\027[0m" failures total 27 | else 28 | if failures = 0 then 29 | Lwt_io.printl "All tests succeeded!" 30 | else 31 | Lwt_io.printlf "%d of %d tests failed." failures total 32 | | (name, test) :: rest -> 33 | let%lwt () = title name in 34 | begin 35 | try%lwt 36 | test () 37 | with exn -> 38 | let%lwt () = Lwt_io.printlf "test failed with: %s" (Printexc.to_string exn) in 39 | let%lwt () = Lwt_io.printl (Printexc.get_backtrace ()) in 40 | return false 41 | end >>= function 42 | | true -> 43 | let%lwt () = 44 | if tty then 45 | Lwt_io.print "\n\027[32;1mTest passed.\n\027[0m\n" 46 | else 47 | Lwt_io.print "\nTest passed.\n\n" 48 | in 49 | run_tests failures (total + 1) rest 50 | | false -> 51 | let%lwt () = 52 | if tty then 53 | Lwt_io.print "\n\027[31;1mTest failed.\n\027[0m\n" 54 | else 55 | Lwt_io.print "\nTest failed.\n\n" 56 | in 57 | run_tests (failures + 1) (total + 1) rest 58 | 59 | let () = Lwt_main.run begin 60 | run_tests 0 0 [ 61 | "serialization", Test_serialization.test; 62 | "string validation", Test_validation.test; 63 | "authentication", Test_auth.test; 64 | (*"communication", Test_communication.test;*) 65 | "garbage collection", Test_gc.test; 66 | ] 67 | end 68 | -------------------------------------------------------------------------------- /src/ppx/ppx_obus.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let rewriter_name = "ppx_obus" 4 | 5 | 6 | let find_attr_expr s attrs = 7 | let expr_of_payload = function 8 | | PStr [{ pstr_desc = Pstr_eval (e, _); _ }] -> Some e 9 | | _ -> None in 10 | try expr_of_payload ( 11 | let payload = 12 | List.find (fun attr -> attr.attr_name.txt = s) attrs 13 | in 14 | payload.attr_payload) 15 | with Not_found -> None 16 | 17 | 18 | let register_obus_exception = function 19 | | { pstr_desc = Pstr_exception exn; pstr_loc } -> 20 | (match find_attr_expr "obus" exn.ptyexn_attributes with 21 | | Some expr -> 22 | let registerer typ = 23 | let loc = pstr_loc in 24 | if Filename.basename pstr_loc.loc_start.pos_fname = "oBus_error.ml" then 25 | [%stri 26 | let () = 27 | let module M = 28 | Register(struct 29 | let name = [%e expr] 30 | exception E of [%t typ] 31 | end) 32 | in () 33 | ] 34 | else 35 | [%stri 36 | let () = 37 | let module M = 38 | OBus_error.Register(struct 39 | let name = [%e expr] 40 | exception E of [%t typ] 41 | end) 42 | in () 43 | ] in 44 | (match exn.ptyexn_constructor.pext_kind with 45 | | Pext_decl (_, Pcstr_tuple [typ], None) -> 46 | Some (registerer typ) 47 | | _ -> 48 | Location.raise_errorf ~loc:pstr_loc 49 | "%s: OBus exceptions take a single string argument" rewriter_name) 50 | | _ -> 51 | None) 52 | | _ -> 53 | None 54 | 55 | 56 | let obus_mapper = object(self) 57 | inherit Ast_traverse.map 58 | 59 | method! structure items = 60 | List.fold_right (fun item acc -> 61 | let item' = self#structure_item item in 62 | match register_obus_exception item with 63 | | Some reg -> 64 | item' :: reg :: acc 65 | | None -> 66 | item' :: acc) 67 | items [] 68 | end 69 | 70 | 71 | let () = 72 | Driver.register_transformation 73 | ~impl:(fun structure -> obus_mapper#structure structure) 74 | rewriter_name 75 | -------------------------------------------------------------------------------- /docs/apiref-intro: -------------------------------------------------------------------------------- 1 | {1 OBus - API Reference} 2 | 3 | {2 OBus library} 4 | 5 | This section describe modules of the core OBus library. OBus is 6 | composed of a lot of modules, but you will usually need only a few of 7 | them. 8 | 9 | {3 Connections and message Buses} 10 | 11 | {!modules: 12 | OBus_bus 13 | OBus_connection 14 | OBus_server 15 | } 16 | 17 | {3 D-Bus objects} 18 | 19 | {!modules: 20 | OBus_proxy 21 | OBus_object 22 | OBus_method 23 | OBus_signal 24 | OBus_property 25 | OBus_member 26 | } 27 | 28 | {3 Introspection} 29 | 30 | {!modules: 31 | OBus_introspect 32 | OBus_introspect_ext 33 | } 34 | 35 | {3 Misc} 36 | 37 | {!modules: 38 | OBus_error 39 | OBus_value 40 | OBus_resolver 41 | OBus_peer 42 | OBus_info 43 | OBus_name 44 | OBus_path 45 | OBus_string 46 | OBus_uuid 47 | OBus_context 48 | } 49 | 50 | {3 OBus low-level API} 51 | 52 | {!modules: 53 | OBus_match 54 | OBus_message 55 | OBus_address 56 | OBus_auth 57 | OBus_transport 58 | OBus_wire 59 | } 60 | 61 | {2 Service bindings} 62 | 63 | This section list bindings to D-Bus services shipped with OBus. 64 | 65 | {3 Notifications} 66 | 67 | Bindings to the freedesktop popup notification service. 68 | 69 | {!modules: 70 | Notification 71 | } 72 | 73 | {3 PolicyKit} 74 | 75 | Bindings to the freedesktop popup PolicyKit service. 76 | 77 | {!modules: 78 | Policy_kit 79 | } 80 | 81 | {3 Hal} 82 | 83 | Bindings to the freedesktop Hal service. 84 | 85 | {!modules: 86 | Hal_manager 87 | Hal_device 88 | } 89 | 90 | {3 UPower} 91 | 92 | Bindings to the freedesktop UPower service. 93 | 94 | {!modules: 95 | UPower 96 | UPower_device 97 | UPower_policy 98 | UPower_wakeups 99 | } 100 | 101 | {3 UPower} 102 | 103 | Bindings to the freedesktop UDisks service. 104 | 105 | {!modules: 106 | UDisks 107 | UDisks_device 108 | UDisks_port 109 | UDisks_adapter 110 | UDisks_expander 111 | } 112 | 113 | {3 NetworkManager} 114 | 115 | Bindings to the NetworkManager service. 116 | 117 | {!modules: 118 | Nm_access_point 119 | Nm_connection 120 | Nm_device 121 | Nm_dhcp4_config 122 | Nm_ip4_config 123 | Nm_ip6_config 124 | Nm_manager 125 | Nm_ppp 126 | Nm_settings 127 | Nm_vpn_connection 128 | Nm_vpn_plugin 129 | } 130 | 131 | {3 Index} 132 | 133 | {!indexlist} 134 | -------------------------------------------------------------------------------- /src/internals/oBus_util.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_util.mli 3 | * ------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** This module contain various functions used by both the library and 11 | the tools *) 12 | 13 | val assoc : 'a -> ('a * 'b) list -> 'b option 14 | (** Same as List.assoc but return an option *) 15 | 16 | val assq : 'a -> ('a * 'b) list -> 'b option 17 | (** Same as List.assq but return an option *) 18 | 19 | val find_map : ('a -> 'b option) -> 'a list -> 'b option 20 | (** [find_map f l] Apply [f] on each element of [l] until it return 21 | [Some x] and return that result or return [None] *) 22 | 23 | val filter_map : ('a -> 'b option) -> 'a list -> 'b list 24 | (** [filter_map f l] apply [f] on each element of [l] and return the 25 | list ef element for which [f] succeed (i.e. return [Some x]) *) 26 | 27 | val part_map : ('a -> 'b option) -> 'a list -> 'b list * 'a list 28 | (** [part_map f l] apply [f] on each element of [l] and return the 29 | list of success and the list of failure *) 30 | 31 | type ('a, 'b) either = 32 | | InL of 'a 33 | | InR of 'b 34 | 35 | val split : ('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list 36 | (** Split a list *) 37 | 38 | val map_option : 'a option -> ('a -> 'b) -> 'b option 39 | 40 | val sha_1 : string -> string 41 | (** Compute the sha1 of a string *) 42 | 43 | val hex_encode : string -> string 44 | val hex_decode : string -> string 45 | (** A hex-encoded string is a string where each character is 46 | replaced by two hexadecimal characters which represent his ascii 47 | code *) 48 | 49 | val homedir : string Lwt.t Lazy.t 50 | (** The home directory *) 51 | 52 | (** {6 Random number generation} *) 53 | 54 | (** All the following functions try to generate random numbers using 55 | /dev/urandom and can fallback to pseudo-random generator *) 56 | 57 | val fill_random : bytes -> int -> int -> unit 58 | (** [fill_random str ofs len] Fill the given string from [ofs] to 59 | [ofs+len-1] with random bytes. *) 60 | 61 | val random_string : int -> string 62 | val random_int : unit -> int 63 | val random_int32 : unit -> int32 64 | val random_int64 : unit -> int64 65 | -------------------------------------------------------------------------------- /tools/introspection/obus_dump.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * obus_dump.ml 3 | * ------------ 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt.Infix 11 | 12 | let usage_msg = Printf.sprintf "Usage: %s cmd args 13 | Execute 'cmd' and dump all messages it sent to session and system bus 14 | options are:" (Filename.basename (Sys.argv.(0))) 15 | 16 | let rec loop pp action what_bus a b = 17 | let%lwt message = OBus_transport.recv a in 18 | Format.fprintf pp "-----@\n@[%s on %s bus:@\n%a@]@." action what_bus 19 | OBus_message.print message; 20 | let%lwt () = OBus_transport.send b message in 21 | loop pp action what_bus a b 22 | 23 | let launch pp what_bus laddresses = 24 | let%lwt addresses = Lazy.force laddresses in 25 | let%lwt server = 26 | OBus_server.make_lowlevel ~capabilities:[`Unix_fd] 27 | (fun server transport -> 28 | ignore begin 29 | let%lwt (_, bus) = OBus_transport.of_addresses ~capabilities:[`Unix_fd] addresses in 30 | Lwt.choose [loop pp "message received" what_bus bus transport; 31 | loop pp "sending message" what_bus transport bus] 32 | end) 33 | in 34 | Unix.putenv (Printf.sprintf "DBUS_%s_BUS_ADDRESS" (String.uppercase_ascii what_bus)) (OBus_address.to_string (OBus_server.addresses server)); 35 | Lwt.return () 36 | 37 | 38 | let () = 39 | let out = ref "/dev/stderr" and cmd_args = ref [] in 40 | let anon_fun s = cmd_args := s :: !cmd_args in 41 | let args = [ 42 | "-o", Arg.Set_string out, " output messages to this file instead of stderr"; 43 | "--", Arg.Rest anon_fun, "command separator"; 44 | ] in 45 | Arg.parse args anon_fun usage_msg; 46 | 47 | let cmd_args = List.rev !cmd_args in 48 | let cmd = match cmd_args with 49 | | [] -> 50 | Arg.usage args usage_msg; 51 | exit 2 52 | | x :: _ -> x 53 | in 54 | 55 | let oc = open_out !out in 56 | let pp = Format.formatter_of_out_channel oc in 57 | 58 | Lwt_main.run begin 59 | let%lwt () = launch pp "session" OBus_address.session <&> launch pp "system" OBus_address.system in 60 | let%lwt _ = Lwt_unix.waitpid [] (Unix.create_process cmd (Array.of_list cmd_args) Unix.stdin Unix.stdout Unix.stderr) in 61 | close_out oc; 62 | Lwt.return () 63 | end 64 | -------------------------------------------------------------------------------- /tests/test_communication.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * test_communication.ml 3 | * --------------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Test the communication with a message bus *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | open OBus_message 15 | 16 | (* number of message to generate *) 17 | let test_count = 100 18 | 19 | let name = "obus.test.communication" 20 | 21 | let rec run_tests con = function 22 | | 0 -> 23 | return () 24 | | n -> 25 | let message = Gen_random.message () in 26 | let%lwt () = OBus_connection.send_message con { 27 | message with 28 | destination = name; 29 | typ = Signal(["obus"; "test"], "obus.test", "test"); 30 | } in 31 | run_tests con (n - 1) 32 | 33 | let rec wait_for_name con = 34 | OBus_bus.name_has_owner con name >>= function 35 | | true -> return () 36 | | false -> let%lwt () = Lwt_unix.sleep 0.1 in wait_for_name con 37 | 38 | let test () = 39 | let%lwt () = Lwt_io.flush Lwt_io.stdout in 40 | match Unix.fork () with 41 | | 0 -> 42 | let%lwt con = OBus_bus.session () in 43 | let%lwt () = wait_for_name con in 44 | let%lwt () = run_tests con test_count in 45 | exit 0 46 | | pid -> 47 | let%lwt () = printlf "sending and receiving %d messages through the message bus." test_count in 48 | let%lwt bus = OBus_bus.session () in 49 | let%lwt _ = OBus_bus.request_name bus name in 50 | let%lwt progress = Progress.make "received" test_count in 51 | let waiter, wakener = wait () in 52 | let count = ref 0 in 53 | ignore (Lwt_sequence.add_r 54 | (function 55 | | { typ = Signal(["obus"; "test"], "obus.test", "test") } -> 56 | ignore (Progress.incr progress); 57 | incr count; 58 | if !count = test_count then 59 | wakeup wakener true; 60 | None 61 | | msg -> 62 | Some msg) 63 | (OBus_connection.incoming_filters bus)); 64 | let%lwt result = waiter in 65 | let%lwt () = Progress.close progress in 66 | let%lwt _ = Lwt_unix.waitpid [] pid in 67 | return result 68 | -------------------------------------------------------------------------------- /examples/battery_monitoring.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * battery_monitoring.ml 3 | * --------------------- 4 | * Copyright : (c) 2011, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt_react 11 | open Lwt 12 | open Lwt_io 13 | 14 | (* List of monitored batteries. *) 15 | let batteries = ref [] 16 | 17 | let print_state device state = 18 | printlf "state of %s: %s" 19 | (OBus_path.to_string (OBus_proxy.path (UPower_device.to_proxy device))) 20 | (match state with 21 | | `Unknown -> "unknown" 22 | | `Charging -> "charging" 23 | | `Discharging -> "discharging" 24 | | `Empty -> "empty" 25 | | `Fully_charged -> "fully charged" 26 | | `Pending_charge -> "pending charge" 27 | | `Pending_discharge -> "pending discharge") 28 | 29 | (* Handle device addition. *) 30 | let monitor_device device = 31 | if List.exists (fun (device', _, _) -> device = device') !batteries then 32 | return () 33 | else begin 34 | let switch = Lwt_switch.create () in 35 | let%lwt signal = OBus_property.monitor (UPower_device.state device) in 36 | let%lwt s = S.map_s (print_state device) signal in 37 | batteries := (device, switch, s) :: !batteries; 38 | return () 39 | end 40 | 41 | (* Handle device removal. *) 42 | let unmonitor_device device = 43 | let%lwt () = 44 | Lwt_list.iter_p 45 | (fun (device', switch, s) -> 46 | if device = device' then begin 47 | S.stop s; 48 | Lwt_switch.turn_off switch 49 | end else 50 | return ()) 51 | !batteries 52 | in 53 | batteries := List.filter (fun (device', _, _) -> device <> device') !batteries; 54 | return () 55 | 56 | let () = Lwt_main.run begin 57 | (* Get the manager proxy. *) 58 | let%lwt manager = UPower.daemon () in 59 | 60 | (* Handle device addition/removal. *) 61 | let%lwt () = 62 | OBus_signal.connect (UPower.device_added manager) 63 | >|= E.map_p monitor_device 64 | >|= E.keep 65 | and () = 66 | OBus_signal.connect (UPower.device_removed manager) 67 | >|= E.map_p unmonitor_device 68 | >|= E.keep 69 | in 70 | 71 | (* Monitor all the batteries initially present on the system. *) 72 | let%lwt devices = UPower.enumerate_devices manager in 73 | let%lwt () = Lwt_list.iter_p monitor_device devices in 74 | 75 | fst (wait ()) 76 | end 77 | -------------------------------------------------------------------------------- /src/internals/oBus_name.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_name.mli 3 | * ------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** D-Bus names *) 11 | 12 | (** For specific restrictions on D-Bus names, see 13 | @see the specification 14 | 15 | General restrictions include: 16 | 17 | - names must not be empty 18 | - names must contains only ascii characters *) 19 | 20 | type bus = OBus_string.t 21 | (** Bus names 22 | 23 | example: "org.freedesktop.DBus", ":1.1" *) 24 | 25 | val validate_bus : OBus_string.validator 26 | 27 | val is_unique : bus -> bool 28 | (** Tell wether a bus name is a unique connection name or not. *) 29 | 30 | type interface = OBus_string.t 31 | (** Interface names 32 | 33 | example: "org.freedesktop.DBus.Introspectable" *) 34 | 35 | val validate_interface : OBus_string.validator 36 | 37 | type member = OBus_string.t 38 | (** Methods/signals/properties names 39 | 40 | example: "StartServiceByName" *) 41 | 42 | val validate_member : OBus_string.validator 43 | 44 | type error = OBus_string.t 45 | (** Error names 46 | 47 | example: "org.freedesktop.Error.UnknownMethod" *) 48 | 49 | val validate_error : OBus_string.validator 50 | 51 | (** {6 D-Bus name translation} *) 52 | 53 | val split : string -> string list 54 | (** Split a name into longest blocks matched by the regular 55 | expression "[A-Z]*[^A-Z.]*": 56 | 57 | [split "SetCPUFreqGovernor" = ["Set"; "CPUFreq"; "Governor"]], 58 | [split "org.freedesktop.DBus" = ["org"; "freedesktop"; "DBus"]] *) 59 | 60 | val ocaml_lid : string -> string 61 | (** Translate a D-Bus name into an ocaml-style lower-identifier: 62 | 63 | [caml_lid "SetCPUFreqGovernor" = "set_cpufreq_governor"] *) 64 | 65 | val ocaml_uid : string -> string 66 | (** Translate a D-Bus name into an ocaml-style upper-identifier: 67 | 68 | [caml_uid "org.freedesktop.DBus" = "Org_freedesktop_dbus"] *) 69 | 70 | val haskell_lid : string -> string 71 | (** Translate a D-Bus name into an haskell-style lower-identifier: 72 | 73 | [haskell_lid "SetCPUFreqGovernor" = "setCPUFreqGovernor"] *) 74 | 75 | val haskell_uid : string -> string 76 | (** Translate a D-Bus name into an haskell-style upper-identifier: 77 | 78 | [haskell_uid "org.freedesktop.DBus" = "OrgFreedesktopDBus"] *) 79 | -------------------------------------------------------------------------------- /src/protocol/oBus_peer.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_peer.ml 3 | * ------------ 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt_react 11 | 12 | type t = { 13 | connection : OBus_connection.t; 14 | name : OBus_name.bus; 15 | } 16 | 17 | let compare = Stdlib.compare 18 | 19 | let connection p = p.connection 20 | let name p = p.name 21 | 22 | let make ~connection ~name = { connection = connection; name = name } 23 | let anonymous c = { connection = c; name = "" } 24 | 25 | let ping peer = 26 | let%lwt reply, () = 27 | OBus_connection.method_call_with_message 28 | ~connection:peer.connection 29 | ~destination:OBus_protocol.bus_name 30 | ~path:[] 31 | ~interface:"org.freedesktop.DBus.Peer" 32 | ~member:"Peer" 33 | ~i_args:OBus_value.C.seq0 34 | ~o_args:OBus_value.C.seq0 35 | () 36 | in 37 | Lwt.return { peer with name = OBus_message.sender reply } 38 | 39 | let get_machine_id peer = 40 | let%lwt mid = 41 | OBus_connection.method_call 42 | ~connection:peer.connection 43 | ~destination:OBus_protocol.bus_name 44 | ~path:[] 45 | ~interface:"org.freedesktop.DBus.Peer" 46 | ~member:"GetMachineId" 47 | ~i_args:OBus_value.C.seq0 48 | ~o_args:(OBus_value.C.seq1 OBus_value.C.basic_string) 49 | () 50 | in 51 | try 52 | Lwt.return (OBus_uuid.of_string mid) 53 | with exn -> 54 | Lwt.fail exn 55 | 56 | let wait_for_exit peer = 57 | match peer.name with 58 | | "" -> 59 | Lwt.fail (Invalid_argument "OBus_peer.wait_for_exit: peer has no name") 60 | | name -> 61 | let switch = Lwt_switch.create () in 62 | let%lwt owner = OBus_resolver.make ~switch peer.connection name in 63 | if S.value owner = "" then 64 | Lwt_switch.turn_off switch 65 | else 66 | (let%lwt _ = E.next (E.filter ((=) "") (S.changes owner)) in 67 | Lwt.return ()) 68 | [%lwt.finally 69 | Lwt_switch.turn_off switch] 70 | 71 | (* +-----------------------------------------------------------------+ 72 | | Private peers | 73 | +-----------------------------------------------------------------+ *) 74 | 75 | type peer = t 76 | 77 | module type Private = sig 78 | type t = private peer 79 | external of_peer : peer -> t = "%identity" 80 | external to_peer : t -> peer = "%identity" 81 | end 82 | 83 | module Private = 84 | struct 85 | type t = peer 86 | external of_peer : peer -> t = "%identity" 87 | external to_peer : t -> peer = "%identity" 88 | end 89 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_access_point.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_access_point.ml 3 | * ------------------ 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | open Lwt 9 | 10 | include OBus_proxy.Private 11 | 12 | open Nm_interfaces.Org_freedesktop_NetworkManager_AccessPoint 13 | 14 | type ap_flag = 15 | [ `Privacy ] 16 | 17 | let flags proxy = 18 | OBus_property.map_r 19 | (fun n -> if (Int32.to_int n) land 0x01 <> 0 then [`Privacy] else []) 20 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Flags proxy) 21 | 22 | type ap_security_flag = 23 | [ `Pair_wep40 24 | | `Pair_wep104 25 | | `Pair_tkip 26 | | `Pair_ccmp 27 | | `Group_wep40 28 | | `Group_wep104 29 | | `Group_tkip 30 | | `Group_ccmp 31 | | `Key_mgmt_psk 32 | | `Key_mgmt_802_1x ] 33 | 34 | let ap_security_flags_of_int32 n = 35 | let n = Int32.to_int n in 36 | let add l bit_mask flag = 37 | if n land bit_mask <> 0 then 38 | flag :: l 39 | else 40 | l 41 | in 42 | let l = [] in 43 | let l = add l 0x001 `Pair_wep40 in 44 | let l = add l 0x002 `Pair_wep104 in 45 | let l = add l 0x004 `Pair_tkip in 46 | let l = add l 0x008 `Pair_ccmp in 47 | let l = add l 0x010 `Group_wep40 in 48 | let l = add l 0x020 `Group_wep104 in 49 | let l = add l 0x040 `Group_tkip in 50 | let l = add l 0x080 `Group_ccmp in 51 | let l = add l 0x100 `Key_mgmt_psk in 52 | let l = add l 0x200 `Key_mgmt_802_1x in 53 | l 54 | 55 | let wpa_flags proxy = 56 | OBus_property.map_r 57 | ap_security_flags_of_int32 58 | (OBus_property.make ~monitor:Nm_monitor.monitor p_WpaFlags proxy) 59 | 60 | let rsn_flags proxy = 61 | OBus_property.map_r 62 | ap_security_flags_of_int32 63 | (OBus_property.make ~monitor:Nm_monitor.monitor p_RsnFlags proxy) 64 | 65 | let ssid proxy = 66 | OBus_property.make ~monitor:Nm_monitor.monitor p_Ssid proxy 67 | 68 | let frequency proxy = 69 | OBus_property.map_r 70 | Int32.to_int 71 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Frequency proxy) 72 | 73 | let hw_address proxy = 74 | OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy 75 | 76 | let mode proxy = 77 | OBus_property.map_r 78 | Int32.to_int 79 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Mode proxy) 80 | 81 | let max_bitrate proxy = 82 | OBus_property.map_r 83 | Int32.to_int 84 | (OBus_property.make ~monitor:Nm_monitor.monitor p_MaxBitrate proxy) 85 | 86 | let strength proxy = 87 | OBus_property.map_r 88 | int_of_char 89 | (OBus_property.make ~monitor:Nm_monitor.monitor p_Strength proxy) 90 | 91 | let properties_changed proxy = 92 | OBus_signal.make s_PropertiesChanged proxy 93 | 94 | let properties proxy = 95 | OBus_property.group ~monitor:Nm_monitor.monitor proxy interface 96 | -------------------------------------------------------------------------------- /bindings/upower/uPower_device.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_device.mli 3 | * ----------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** UPower device interface *) 11 | 12 | include OBus_proxy.Private 13 | 14 | (** {6 Types} *) 15 | 16 | (** Type of power source *) 17 | type typ = 18 | [ `Unknown 19 | | `Line_power 20 | | `Battery 21 | | `Ups 22 | | `Monitor 23 | | `Mouse 24 | | `Keyboard 25 | | `Pda 26 | | `Phone ] 27 | 28 | (** The battery power state *) 29 | type state = 30 | [ `Unknown 31 | | `Charging 32 | | `Discharging 33 | | `Empty 34 | | `Fully_charged 35 | | `Pending_charge 36 | | `Pending_discharge ] 37 | 38 | (** Technology used in the battery *) 39 | type technology = 40 | [ `Unknown 41 | | `Lithium_ion 42 | | `Lithium_polymer 43 | | `Lithium_iron_phosphate 44 | | `Lead_acid 45 | | `Nickel_cadmium 46 | | `Nickel_metal_hydride ] 47 | 48 | val general_error : OBus_error.name 49 | 50 | (** {6 Methods} *) 51 | 52 | val get_statistics : t -> typ : string -> (float * float) list Lwt.t 53 | val get_history : t -> typ : string -> timespan : int -> resolution : int -> (int * float * int) list Lwt.t 54 | val refresh : t -> unit Lwt.t 55 | 56 | (** {6 Signals} *) 57 | 58 | val changed : t -> unit OBus_signal.t 59 | 60 | (** {6 Properties} *) 61 | 62 | val recall_url : t -> string OBus_property.r 63 | val recall_vendor : t -> string OBus_property.r 64 | val recall_notice : t -> bool OBus_property.r 65 | val technology : t -> technology OBus_property.r 66 | val capacity : t -> float OBus_property.r 67 | val is_rechargeable : t -> bool OBus_property.r 68 | val state : t -> state OBus_property.r 69 | val is_present : t -> bool OBus_property.r 70 | val percentage : t -> float OBus_property.r 71 | val time_to_full : t -> int64 OBus_property.r 72 | val time_to_empty : t -> int64 OBus_property.r 73 | val voltage : t -> float OBus_property.r 74 | val energy_rate : t -> float OBus_property.r 75 | val energy_full_design : t -> float OBus_property.r 76 | val energy_full : t -> float OBus_property.r 77 | val energy_empty : t -> float OBus_property.r 78 | val energy : t -> float OBus_property.r 79 | val online : t -> bool OBus_property.r 80 | val has_statistics : t -> bool OBus_property.r 81 | val has_history : t -> bool OBus_property.r 82 | val power_supply : t -> bool OBus_property.r 83 | val typ : t -> typ OBus_property.r 84 | val update_time : t -> int64 OBus_property.r 85 | val serial : t -> string OBus_property.r 86 | val model : t -> string OBus_property.r 87 | val vendor : t -> string OBus_property.r 88 | val native_path : t -> string OBus_property.r 89 | 90 | val properties : t -> OBus_property.group 91 | -------------------------------------------------------------------------------- /bindings/upower/uPower_policy.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_policy.ml 3 | * ---------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | type cookie = int 13 | 14 | type latency = [ `Cpu_dma | `Network ] 15 | 16 | let string_of_latency = function 17 | | `Cpu_dma -> "cpu_dma" 18 | | `Network -> "network" 19 | 20 | let latency_of_string = function 21 | | "cpu_dma" -> `Cpu_dma 22 | | "network" -> `Network 23 | | latency -> Printf.ksprintf failwith "unknown latency type (%S)" latency 24 | 25 | type latency_request = { 26 | lr_cookie : cookie; 27 | lr_uid : int; 28 | lr_pid : int; 29 | lr_exec : string; 30 | lr_timespec : int64; 31 | lr_persistent : bool; 32 | lr_typ : latency; 33 | lr_reserved : string; 34 | lr_value : int; 35 | } 36 | 37 | open UPower_interfaces.Org_freedesktop_UPower_QoS 38 | 39 | let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Policy"] 40 | 41 | let set_minimum_latency daemon ~latency ~value = 42 | OBus_method.call m_SetMinimumLatency (proxy daemon) (string_of_latency latency, Int32.of_int value) 43 | 44 | let request_latency daemon ~latency ~value ~persistent = 45 | let value = Int32.of_int value in 46 | let%lwt cookie = OBus_method.call m_RequestLatency (proxy daemon) (string_of_latency latency, value, persistent) in 47 | let cookie = Int32.to_int cookie in 48 | return cookie 49 | 50 | let cancel_request daemon ~latency ~cookie = 51 | let cookie = Int32.of_int cookie in 52 | OBus_method.call m_CancelRequest (proxy daemon) (string_of_latency latency, cookie) 53 | 54 | let get_latency daemon ~latency = 55 | let%lwt value = OBus_method.call m_GetLatency (proxy daemon) (string_of_latency latency) in 56 | let value = Int32.to_int value in 57 | return value 58 | 59 | let latency_changed daemon = 60 | OBus_signal.map 61 | (fun (latency, value) -> 62 | (latency_of_string latency, Int32.to_int value)) 63 | (OBus_signal.make s_LatencyChanged (proxy daemon)) 64 | 65 | let get_latency_requests daemon = 66 | let%lwt requests = OBus_method.call m_GetLatencyRequests (proxy daemon) () in 67 | return 68 | (List.map 69 | (fun (cookie, uid, pid, exec, timespec, persistent, typ, reserved, value) -> { 70 | lr_cookie = Int32.to_int cookie; 71 | lr_uid = Int32.to_int uid; 72 | lr_pid = Int32.to_int pid; 73 | lr_exec = exec; 74 | lr_timespec = timespec; 75 | lr_persistent = persistent; 76 | lr_typ = latency_of_string typ; 77 | lr_reserved = reserved; 78 | lr_value = Int32.to_int value; 79 | }) 80 | requests) 81 | 82 | let requests_changed daemon = 83 | OBus_signal.make s_RequestsChanged (proxy daemon) 84 | -------------------------------------------------------------------------------- /src/protocol/oBus_interfaces.obus: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_interfaces.obus 3 | * -------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | interface org.freedesktop.DBus.Peer { 11 | method Ping : () -> () 12 | method GetMachineId : () -> (machine_id : string) 13 | } 14 | 15 | interface org.freedesktop.DBus.Introspectable { 16 | method Introspect : () -> (result : string) 17 | } 18 | 19 | interface org.freedesktop.DBus.Properties { 20 | method Get : (interface_name : string, member : string) -> (value : variant) 21 | method Set : (interface_name : string, member : string, value : variant) -> () 22 | method GetAll : (interface_name : string) -> (values : (string, variant) dict) 23 | signal PropertiesChanged : (interface_name : string, updates : (string, variant) dict, invalidates : string array) 24 | } 25 | 26 | interface org.freedesktop.DBus { 27 | method Hello : () -> (name : string) 28 | 29 | flag request_name_flags : uint32 { 30 | 0b001: allow_replacement 31 | 0b010: replace_existing 32 | 0b100: do_not_queue 33 | } 34 | 35 | enum request_name_result : uint32 { 36 | 1: primary_owner 37 | 2: in_queue 38 | 3: exists 39 | 4: already_owner 40 | } 41 | 42 | method RequestName : (name : string, flags : request_name_flags) -> (result : request_name_result) 43 | 44 | enum release_name_result : uint32 { 45 | 1: released 46 | 2: non_existent 47 | 3: not_owner 48 | } 49 | 50 | method ReleaseName : (name : string) -> (result : release_name_result) 51 | 52 | enum start_service_by_name_result : uint32 { 53 | 1: success 54 | 2: already_running 55 | } 56 | 57 | method StartServiceByName : (name : string, flags : uint32) -> (result : start_service_by_name_result) 58 | 59 | method UpdateActivationEnvironment : (x1 : (string, string) dict) -> () 60 | method NameHasOwner : (x1 : string) -> (x1 : boolean) 61 | method ListNames : () -> (x1 : string array) 62 | method ListActivatableNames : () -> (x1 : string array) 63 | method AddMatch : (x1 : string) -> () 64 | method RemoveMatch : (x1 : string) -> () 65 | method GetNameOwner : (x1 : string) -> (x1 : string) 66 | method ListQueuedOwners : (x1 : string) -> (x1 : string array) 67 | method GetConnectionUnixUser : (x1 : string) -> (x1 : uint32) 68 | method GetConnectionUnixProcessID : (x1 : string) -> (x1 : uint32) 69 | method GetAdtAuditSessionData : (x1 : string) -> (x1 : byte array) 70 | method GetConnectionSELinuxSecurityContext : (x1 : string) -> (x1 : byte array) 71 | method ReloadConfig : () -> () 72 | method GetId : () -> (x1 : string) 73 | signal NameOwnerChanged : (x1 : string, x2 : string, x3 : string) 74 | signal NameLost : (x1 : string) 75 | signal NameAcquired : (x1 : string) 76 | } 77 | -------------------------------------------------------------------------------- /src/protocol/oBus_wire.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_lowlevel.mli 3 | * ----------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Message serialization/deserialization *) 11 | 12 | exception Data_error of string 13 | (** Exception raised when a message can not be sent. The parameter is an 14 | error message. 15 | 16 | Possible reasons are: the message is too big or contains arrays 17 | that are too big. *) 18 | 19 | exception Protocol_error of string 20 | (** Exception raised when a received message is not valid. 21 | 22 | Possible reasons are: 23 | 24 | - a size limit is exceeded 25 | - a name/string/object-path is not valid 26 | - a boolean value is other than 0 or 1 27 | - ... *) 28 | 29 | val read_message : Lwt_io.input_channel -> OBus_message.t Lwt.t 30 | (** [read_message ic] deserializes a message from a channel. It 31 | fails if the message contains file descriptors. *) 32 | 33 | val write_message : Lwt_io.output_channel -> ?byte_order : Lwt_io.byte_order -> OBus_message.t -> unit Lwt.t 34 | (** [write_message oc ?byte_order message] serializes a message to a 35 | channel. It fails if the message contains file descriptors. *) 36 | 37 | val message_of_string : string -> Unix.file_descr array -> OBus_message.t 38 | (** [message_of_string buf fds] returns a message from a 39 | string. [fds] is used to resolv file descriptors the message may 40 | contains. *) 41 | 42 | val string_of_message : ?byte_order : Lwt_io.byte_order -> OBus_message.t -> string * Unix.file_descr array 43 | (** Marshal a message into a string. Returns also the list of file 44 | descriptors that must be sent with the message. *) 45 | 46 | type reader 47 | (** A reader which support unix fd passing *) 48 | 49 | val reader : Lwt_unix.file_descr -> reader 50 | (** [reader unix_socket] creates a reader from a unix socket *) 51 | 52 | val read_message_with_fds : reader -> OBus_message.t Lwt.t 53 | (** Read a message with its file descriptors from the given 54 | reader *) 55 | 56 | val close_reader : reader -> unit Lwt.t 57 | (** [close_reader reader] closes the given reader. 58 | 59 | Note: this does not close the underlying file descriptor. *) 60 | 61 | type writer 62 | (** A writer which support unix fd passing *) 63 | 64 | val writer : Lwt_unix.file_descr -> writer 65 | (** [writer unix_socket] creates a writer from a unix socket *) 66 | 67 | val write_message_with_fds : writer -> ?byte_order : Lwt_io.byte_order -> OBus_message.t -> unit Lwt.t 68 | (** Write a message with its file descriptors on the given writer *) 69 | 70 | val close_writer : writer -> unit Lwt.t 71 | (** [close_writer writer] closes the given writer. 72 | 73 | Note: this does not close the underlying file descriptor. *) 74 | 75 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | OBus 2 | ==== 3 | 4 | [![Build Status](https://travis-ci.com/ocaml-community/obus.svg?branch=master)](https://travis-ci.com/ocaml-community/obus) 5 | 6 | OBus is a pure OCaml implementation of the D-Bus protocol. It aims to 7 | provide a clean and easy way for ocaml programmers to access and 8 | provide D-Bus services. 9 | 10 | OBus is using the cooperative threading library Lwt, which make it 11 | very simple to fully exploit the asynchronous nature of D-Bus. 12 | 13 | Dependencies 14 | ------------ 15 | 16 | Make sure you have [dune](https://dune.build/) 17 | installed, and install all the missing dependencies listed in 18 | the output of this command: 19 | 20 | $ dune external-lib-deps @install --missing 21 | 22 | Installation 23 | ------------ 24 | 25 | The recommended way to install obus and its dependencies is via 26 | [opam](https://opam.ocaml.org/): `opam install obus`. 27 | 28 | Manual installation from sources 29 | -------------------------------- 30 | 31 | To build and install obus: 32 | 33 | $ dune build @install 34 | 35 | ### Tests _(optionnal)_ 36 | 37 | To build and execute tests: 38 | 39 | $ dune runtest 40 | 41 | Using the library 42 | ----------------- 43 | 44 | OBus install the following packages: 45 | 46 | * `obus`: the core library, implementing the D-Bus protocol, 47 | * `obus.ppx`: syntax extensions to aid registering OBus exceptions. 48 | * `obus.notification`: interface to the freedesktop Notification 49 | service, 50 | * `obus.hal`: interface to the freedesktop Hal service, 51 | * `obus.upower`: interface to the freedesktop UPower service, 52 | * `obus.udisks`: interface to the freedesktop UDisks service, 53 | * `obus.policykit`: interface to the freedesktop PolicyKit servie. 54 | 55 | Using the tools 56 | --------------- 57 | 58 | There are several tools provided in the obus distribution: 59 | 60 | * `obus-dump`, to execute a command and dump all messages that goes 61 | throug the session and/or system message bus, 62 | * `obus-introspect` which can recursively introspect a D-Bus service, 63 | * `obus-gen-interface`, to convert D-Bus introspection files into 64 | ocaml definition modules, 65 | * `obus-gen-client` and obus-gen-server which can generate template 66 | for using or implementing D-Bus servies, 67 | * `obus-xml2idl` and obus-idl2xml to convert xml introspection 68 | documents to the obus idl format, and vice versa. 69 | 70 | There are manual pages for all this tools. 71 | 72 | The caml files generated by obus-gen-client and obus-gen-server are 73 | meant to be edited and adapted. In practice introspections files 74 | contains only marshaling informations so it is often not sufficient 75 | for creating a usable binding. 76 | 77 | Here is a simple example of use of the tools: 78 | 79 | $ obus-introspect org.freedesktop.Notifications /org/freedesktop/Notifications > notif.xml 80 | $ obus-gen-interface notif.xml 81 | $ obus-gen-client notif.xml 82 | -------------------------------------------------------------------------------- /src/protocol/oBus_proxy.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_proxy.ml 3 | * ------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let section = Lwt_log.Section.make "obus(proxy)" 11 | 12 | open OBus_peer 13 | open OBus_message 14 | 15 | type t = { 16 | peer : OBus_peer.t; 17 | path : OBus_path.t; 18 | } 19 | 20 | let compare = Stdlib.compare 21 | 22 | let make ~peer ~path = { peer = peer; path = path } 23 | 24 | let peer proxy = proxy.peer 25 | let path proxy = proxy.path 26 | let connection proxy = proxy.peer.connection 27 | let name proxy = proxy.peer.name 28 | 29 | type proxy = t 30 | 31 | module type Private = sig 32 | type t = private proxy 33 | external of_proxy : proxy -> t = "%identity" 34 | external to_proxy : t -> proxy = "%identity" 35 | end 36 | 37 | module Private = 38 | struct 39 | type t = proxy 40 | external of_proxy : proxy -> t = "%identity" 41 | external to_proxy : t -> proxy = "%identity" 42 | end 43 | 44 | (* +-----------------------------------------------------------------+ 45 | | Method calls | 46 | +-----------------------------------------------------------------+ *) 47 | 48 | let call proxy ~interface ~member ~i_args ~o_args args = 49 | OBus_connection.method_call 50 | ~connection:proxy.peer.connection 51 | ~destination:proxy.peer.name 52 | ~path:proxy.path 53 | ~interface 54 | ~member 55 | ~i_args 56 | ~o_args 57 | args 58 | 59 | let call_with_context proxy ~interface ~member ~i_args ~o_args args = 60 | let%lwt msg, result = 61 | OBus_connection.method_call_with_message 62 | ~connection:proxy.peer.connection 63 | ~destination:proxy.peer.name 64 | ~path:proxy.path 65 | ~interface 66 | ~member 67 | ~i_args 68 | ~o_args 69 | args 70 | in 71 | Lwt.return (OBus_context.make proxy.peer.connection msg, result) 72 | 73 | let call_no_reply proxy ~interface ~member ~i_args args = 74 | OBus_connection.method_call_no_reply 75 | ~connection:proxy.peer.connection 76 | ~destination:proxy.peer.name 77 | ~path:proxy.path 78 | ~interface 79 | ~member 80 | ~i_args 81 | args 82 | 83 | (* +-----------------------------------------------------------------+ 84 | | Introspection | 85 | +-----------------------------------------------------------------+ *) 86 | 87 | let introspect proxy = 88 | let%lwt str = 89 | call proxy ~interface:"org.freedesktop.DBus.Introspectable" ~member:"Introspect" 90 | ~i_args:OBus_value.C.seq0 91 | ~o_args:(OBus_value.C.seq1 OBus_value.C.basic_string) 92 | () 93 | in 94 | try 95 | Lwt.return (OBus_introspect.input (Xmlm.make_input ~strip:true (`String(0, str)))) 96 | with Xmlm.Error((line, column), err) -> 97 | Lwt.fail (Failure(Printf.sprintf "OBus_proxy.introspect: invalid document, at line %d: %s" line (Xmlm.error_message err))) 98 | -------------------------------------------------------------------------------- /src/protocol/oBus_address_lexer.mll: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_address_lexer.mll 3 | * ---------------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | { 11 | exception Fail of int * string 12 | 13 | let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum 14 | 15 | let fail lexbuf fmt = 16 | Printf.ksprintf 17 | (fun msg -> raise (Fail(pos lexbuf, msg))) 18 | fmt 19 | } 20 | 21 | let name = [^ ':' ',' ';' '=']+ 22 | 23 | rule addresses = parse 24 | | eof { [] } 25 | | "" { address_plus lexbuf } 26 | 27 | and address_plus = parse 28 | | name as name { 29 | check_colon lexbuf; 30 | let parameters = parameters lexbuf in 31 | if semi_colon lexbuf then 32 | (name, parameters) :: address_plus lexbuf 33 | else begin 34 | check_eof lexbuf; 35 | [(name, parameters)] 36 | end 37 | } 38 | | ":" { 39 | fail lexbuf "empty transport name" 40 | } 41 | | eof { 42 | fail lexbuf "address expected" 43 | } 44 | 45 | and semi_colon = parse 46 | | ";" { true } 47 | | "" { false } 48 | 49 | and check_eof = parse 50 | | eof { () } 51 | | _ as ch { fail lexbuf "invalid character %C" ch } 52 | 53 | and check_colon = parse 54 | | ":" { () } 55 | | "" { fail lexbuf "colon expected after transport name" } 56 | 57 | and parameters = parse 58 | | name as key { 59 | check_equal lexbuf; 60 | let value = value (Buffer.create 42) lexbuf in 61 | if coma lexbuf then 62 | (key, value) :: parameters_plus lexbuf 63 | else 64 | [(key, value)] 65 | } 66 | | "=" { fail lexbuf "empty key" } 67 | | "" { [] } 68 | 69 | and parameters_plus = parse 70 | | name as key { 71 | check_equal lexbuf; 72 | let value = value (Buffer.create 42) lexbuf in 73 | if coma lexbuf then 74 | (key, value) :: parameters_plus lexbuf 75 | else 76 | [(key, value)] 77 | } 78 | | "=" { fail lexbuf "empty key" } 79 | | "" { fail lexbuf "parameter expected" } 80 | 81 | and coma = parse 82 | | "," { true } 83 | | "" { false } 84 | 85 | and check_equal = parse 86 | | "=" { () } 87 | | "" { fail lexbuf "equal expected after key" } 88 | 89 | and value buf = parse 90 | | [ '0'-'9' 'A'-'Z' 'a'-'z' '_' '-' '/' '.' '\\' ] as ch { 91 | Buffer.add_char buf ch; 92 | value buf lexbuf 93 | } 94 | | "%" { 95 | Buffer.add_string buf (unescape lexbuf); 96 | value buf lexbuf 97 | } 98 | | "" { 99 | Buffer.contents buf 100 | } 101 | 102 | and unescape = parse 103 | | [ '0'-'9' 'a'-'f' 'A'-'F' ] [ '0'-'9' 'a'-'f' 'A'-'F' ] as str 104 | { OBus_util.hex_decode str } 105 | | "" 106 | { failwith "two hexdigits expected after '%'" } 107 | -------------------------------------------------------------------------------- /utils/obus-mode.el: -------------------------------------------------------------------------------- 1 | ;; obus-mode.el 2 | ;; ------------ 3 | ;; Copyright : (c) 2010, Jeremie Dimino 4 | ;; Licence : BSD3 5 | 6 | (require 'tuareg) 7 | 8 | (defconst obus-keywords '("interface" "method" "signal" 9 | "property_r" "property_w" "property_rw" 10 | "annotation" "with" "enum" "flag") 11 | "List of keywords for the obus-mode") 12 | 13 | (defconst obus-member-keywords '("method" "signal" 14 | "property_r" "property_w" "property_rw") 15 | "List of keywords used for defining D-Bus members") 16 | 17 | (defvar obus-file nil 18 | "Whether the current buffer is an obus idl file") 19 | 20 | (defun obus-tuareg-mode-hook () 21 | "Setup the tuareg mode for obus idl files" 22 | (if obus-file 23 | (progn 24 | (setq obus-file nil) 25 | (make-local-variable 'tuareg-governing-phrase-regexp) 26 | (make-local-variable 'tuareg-keyword-alist) 27 | (make-local-variable 'tuareg-font-lock-keywords) 28 | 29 | (setq tuareg-governing-phrase-regexp 30 | (regexp-opt 31 | '("interface" "method" "signal" 32 | "property_r" "property_w" "property_rw" 33 | "annotation" "enum" "flag") 34 | `words)) 35 | (setq tuareg-keyword-alist (mapcar (lambda (x) (cons x 2)) obus-keywords)) 36 | 37 | (setq tuareg-font-lock-keywords 38 | (list 39 | (list "[(){}:*=,]\\|->" 40 | 0 'font-lock-keyword-face nil nil) 41 | (list (regexp-opt obus-keywords `words) 42 | 0 'font-lock-keyword-face nil nil) 43 | (list (concat (regexp-opt obus-member-keywords `words) "[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\)\\>") 44 | 2 'font-lock-function-name-face 'keep nil) 45 | (list "\\[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\([.][A-Za-z0-9_]+\\)+\\)\\>" 46 | 1 'font-lock-constant-face 'keep nil) 47 | (list "\\<\\(enum\\|flag\\)\\>[ \t\n]+\\([A-Za-z_][A-Za-z0-9_]*\\)\\>" 48 | 2 'font-lock-type-face 'keep nil) 49 | (list "\\<\\([A-Za-z_][A-Za-z0-9_.]+\\)[ \t\n]*\\(=\\|:\\)" 50 | 1 'font-lock-variable-name-face 'keep nil) 51 | (list "\\([0-9][0-9a-zA-Z+-.]*\\|'.'\\|\"[^\"]*\"\\)[ \t\n]*:[ \t\n]*\\([A-Za-z_][A-Za-z0-9_]*\\)\\>" 52 | 2 'font-lock-variable-name-face 'keep nil) 53 | (list ":[ \t\n]*\\(\\([_--->.* \t]\\|\\w\\|(['~?]*\\([_--->.,* \t]\\|\\w\\)*)\\)*\\)" 54 | 1 'font-lock-type-face 'keep nil) 55 | (list (regexp-opt obus-keywords `words))))))) 56 | 57 | (add-hook 'tuareg-mode-hook 'obus-tuareg-mode-hook) 58 | 59 | ;;;###autoload (add-to-list 'auto-mode-alist '("\\.obus\\'" . obus-mode)) 60 | 61 | ;;;###autoload 62 | (defun obus-mode () 63 | "Major mode for editing obus idl files" 64 | (interactive) 65 | (print "toto") 66 | (setq obus-file t) 67 | (tuareg-mode)) 68 | 69 | (provide 'obus-mode) 70 | -------------------------------------------------------------------------------- /src/protocol/oBus_transport.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_transport.mli 3 | * ------------------ 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Low-level transporting of messages *) 11 | 12 | type t 13 | (** Type of message transport *) 14 | 15 | val recv : t -> OBus_message.t Lwt.t 16 | (** [recv tr] receives one message from the given transport *) 17 | 18 | val send : t -> OBus_message.t -> unit Lwt.t 19 | (** [send tr msg] sends [msg] over the transport [tr]. *) 20 | 21 | val capabilities : t -> OBus_auth.capability list 22 | (** Returns the capabilities of the transport *) 23 | 24 | val shutdown : t -> unit Lwt.t 25 | (** [shutdown tr] frees resources allocated by the given transport *) 26 | 27 | val make : 28 | ?switch : Lwt_switch.t -> 29 | recv : (unit -> OBus_message.t Lwt.t) -> 30 | send : (OBus_message.t -> unit Lwt.t) -> 31 | ?capabilities : OBus_auth.capability list -> 32 | shutdown : (unit -> unit Lwt.t) -> unit -> t 33 | (** [make ?switch ~recv ~send ~support_unxi_fd ~shutdown ()] creates 34 | a new transport from the given functions. @param capabilities 35 | defaults to [[]]. 36 | 37 | Notes: 38 | - message reading/writing are serialized by obus, so there is no 39 | need to handle concurrent access to transport 40 | *) 41 | 42 | val loopback : unit -> t 43 | (** Loopback transport, each message sent is received on the same 44 | transport *) 45 | 46 | val socket : ?switch : Lwt_switch.t -> ?capabilities : OBus_auth.capability list -> Lwt_unix.file_descr -> t 47 | (** [socket ?switch ?capabilities socket] creates a socket 48 | transport. 49 | 50 | @param capabilities defaults to [[]]. For unix sockets, the 51 | [`Unix_fd] capability is accepted. *) 52 | 53 | val of_addresses : 54 | ?switch : Lwt_switch.t -> 55 | ?capabilities : OBus_auth.capability list -> 56 | ?mechanisms : OBus_auth.Client.mechanism list -> 57 | OBus_address.t list -> 58 | (OBus_address.guid * t) Lwt.t 59 | (** [of_addresses ?switch ?capabilities ?mechanisms addresses] tries to: 60 | 61 | - connect to the server using one of the given given addresses, 62 | - authenticate itself to the server using [mechanisms], which 63 | defaults to {!OBus_auth.Client.default_mechanisms}, 64 | - negotiates [capabilities], which defaults to 65 | {!OBus_auth.capabilities} 66 | 67 | If all succeeded, it returns the server address guid and the 68 | newly created transport, which is ready to send and receive 69 | messages. 70 | 71 | Note about errors: 72 | - if one of the addresses is not valid, or [addresses = []], 73 | it raises [Invalid_argument], 74 | - if all connections failed, it raises the exception raised 75 | by the try on first address, which is either a [Failure] or 76 | a [Unix.Unix_error] 77 | - if the authentication failed, a {!OBus_auth.Auth_error} is 78 | raised 79 | *) 80 | -------------------------------------------------------------------------------- /bindings/network-manager/nm_settings.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * nm_settings.ml 3 | * -------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | *) 7 | 8 | open Lwt 9 | 10 | include OBus_proxy.Private 11 | 12 | open Nm_interfaces.Org_freedesktop_NetworkManagerSettings 13 | 14 | let user () = 15 | let%lwt bus = OBus_bus.session () in 16 | return (OBus_proxy.make 17 | (OBus_peer.make bus "org.freedesktop.NetworkManagerUserSettings") 18 | [ "org"; "freedesktop"; "NetworkManagerSettings" ]) 19 | 20 | let system () = 21 | let%lwt bus = OBus_bus.system () in 22 | return (OBus_proxy.make 23 | (OBus_peer.make bus "org.freedesktop.NetworkManagerSystemSettings") 24 | [ "org"; "freedesktop"; "NetworkManagerSettings" ]) 25 | 26 | module Connection = 27 | struct 28 | include OBus_proxy.Private 29 | 30 | open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection 31 | 32 | let update proxy ~properties = 33 | OBus_method.call m_Update proxy properties 34 | 35 | let delete proxy = 36 | OBus_method.call m_Delete proxy () 37 | 38 | let get_settings proxy = 39 | OBus_method.call m_GetSettings proxy () 40 | 41 | let updated proxy = 42 | OBus_signal.make s_Updated proxy 43 | 44 | let removed proxy = 45 | OBus_signal.make s_Removed proxy 46 | 47 | module Secrets = 48 | struct 49 | open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection_Secrets 50 | 51 | let get_secrets proxy ~setting_name ~hints ~request_new = 52 | OBus_method.call m_GetSecrets proxy (setting_name, hints, request_new) 53 | end 54 | end 55 | 56 | module System = 57 | struct 58 | open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_System 59 | 60 | let save_hostname proxy ~hostname = 61 | OBus_method.call m_SaveHostname proxy hostname 62 | 63 | let hostname proxy = 64 | OBus_property.make ~monitor:Nm_monitor.monitor p_Hostname proxy 65 | 66 | let can_modify proxy = 67 | OBus_property.make ~monitor:Nm_monitor.monitor p_CanModify proxy 68 | 69 | let properties_changed proxy = 70 | OBus_signal.make s_PropertiesChanged proxy 71 | 72 | let check_permissions proxy = 73 | OBus_signal.make s_CheckPermissions proxy 74 | 75 | let get_permissions proxy = 76 | let%lwt permissions = OBus_method.call m_GetPermissions proxy () in 77 | let permissions = Int32.to_int permissions in 78 | return permissions 79 | end 80 | 81 | let list_connections proxy = 82 | let%lwt (context, connections) = OBus_method.call_with_context m_ListConnections proxy () in 83 | return ( 84 | List.map 85 | (fun path -> 86 | Connection.of_proxy 87 | (OBus_proxy.make (OBus_context.sender context) path)) 88 | connections 89 | ) 90 | 91 | let add_connection proxy ~connection = 92 | OBus_method.call m_AddConnection proxy connection 93 | 94 | let new_connection proxy = 95 | OBus_signal.map_with_context 96 | (fun context connection -> 97 | Connection.of_proxy (OBus_proxy.make (OBus_context.sender context) connection)) 98 | (OBus_signal.make s_NewConnection proxy) 99 | -------------------------------------------------------------------------------- /src/internals/oBus_xml_parser.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_xml_parser.mli 3 | * ------------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Monadic xml parsing *) 11 | 12 | (** This module implements a simple monadic xml parser. 13 | 14 | It is intended to make it easy to write XML document parsers. In 15 | OBus it is used to parse introspection document. *) 16 | 17 | exception Parse_failure of Xmlm.pos * string 18 | 19 | type xml_parser 20 | (** Type of an xml parser. It is used to parse a sequence of 21 | arguments and children of an element. *) 22 | 23 | type 'a node 24 | (** Type of a single xml node parser, returning a value of type 25 | ['a] *) 26 | 27 | val failwith : xml_parser -> string -> 'a 28 | (** Fail at current position with the given error message *) 29 | 30 | val input : Xmlm.input -> 'a node -> 'a 31 | (** Run a parser on a xml input. If it fails it raises a 32 | [Parse_failure] *) 33 | 34 | (** {6 Parsing of attributes} *) 35 | 36 | (** For the following functions, the first argument is the attribute 37 | name and each letter mean: 38 | 39 | - [o] : the attribute is optionnal 40 | - [r] : the attribute is required 41 | - [d] : a default value is given 42 | - [f] : a associative list for the attribute value is specified. *) 43 | 44 | val ar : xml_parser -> string -> string 45 | val ao : xml_parser -> string -> string option 46 | val ad : xml_parser -> string -> string -> string 47 | val afr : xml_parser -> string -> (string * 'a) list -> 'a 48 | val afo : xml_parser -> string -> (string * 'a) list -> 'a option 49 | val afd : xml_parser -> string -> 'a -> (string * 'a) list -> 'a 50 | 51 | (** {6 Parsing of elements} *) 52 | 53 | val elt : string -> (xml_parser -> 'a) -> 'a node 54 | (** [elt typ parser] creates a node parser. It will parse element of 55 | type [typ]. [parser] is used to parse the attributes and 56 | children of the element. 57 | 58 | Note that [parser] must consume all children, if some are left 59 | unparsed the parsing will fail. *) 60 | 61 | val pcdata : string node 62 | (** [pcdata f] parse one PCData *) 63 | 64 | val map : 'a node -> ('a -> 'b) -> 'b node 65 | (** [map node f] wraps the result of a node parser with [f] *) 66 | 67 | val union : 'a node list -> 'a node 68 | (** [union nodes] Node parser which parses any node matched by one of 69 | the given node parsers *) 70 | 71 | (** {6 Modifiers} *) 72 | 73 | val one : xml_parser -> 'a node -> 'a 74 | (** [one node] parse exactly one node with the given node parser. It 75 | will fail if there is 0 or more than one node matched by 76 | [node]. *) 77 | 78 | val opt : xml_parser -> 'a node -> 'a option 79 | (** same as [one] but do not fail if there is no node matched by 80 | [node]. *) 81 | 82 | val any : xml_parser -> 'a node -> 'a list 83 | (** [any node] Parse all element matched by [node]. The resulting 84 | list is in the same order as the order in which nodes appears in 85 | the xml. *) 86 | -------------------------------------------------------------------------------- /src/protocol/oBus_server.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_server.mli 3 | * --------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Servers for one-to-one communication *) 11 | 12 | type t 13 | (** Type of a server *) 14 | 15 | val addresses : t -> OBus_address.t list 16 | (** [addresses server] returns all the addresses the server is 17 | listenning on. These addresses must be passed to clients so they 18 | can connect to [server]. *) 19 | 20 | val shutdown : t -> unit Lwt.t 21 | (** [shutdown server] shutdowns the given server. It terminates when 22 | all listeners (a server may listen on several addresses) have 23 | exited. If the server has already been shut down, it does 24 | nothing. *) 25 | 26 | val make : 27 | ?switch : Lwt_switch.t -> 28 | ?capabilities : OBus_auth.capability list -> 29 | ?mechanisms : OBus_auth.Server.mechanism list -> 30 | ?addresses : OBus_address.t list -> 31 | ?allow_anonymous : bool -> 32 | (t -> OBus_connection.t -> unit) -> t Lwt.t 33 | (** [make ?switch ?capabilities ?mechanisms ?addresses ?allow_anonymous f] 34 | Creates a server which will listen on all of the given addresses. 35 | 36 | @param capabilites is the set of the server's capabilities, 37 | @param mechanisms is the list of authentication mechanisms 38 | supported by the server, 39 | @param addresses default to 40 | [{ name = "unix"; args = [("tmpdir", "/tmp")]], 41 | @param allow_anonymous tell whether clients using anonymous 42 | authentication will be accepted. It defaults to [false], 43 | @param capabilities is the list of supported capabilities, it 44 | defaults to {!OBus_auth.capabilities} 45 | @param f is the callback which receive new clients. It takes 46 | as arguments the server and the connection for the client. 47 | 48 | About errors: 49 | - if no addresses are provided, it raises [Invalid_argument], 50 | - if an address is invalid, it raises [Invalid_argument] 51 | - if listening fails for one of the addresses, it fails with the 52 | exception reported for that address 53 | 54 | It succeeds if it can listen on at least one address. 55 | 56 | When a new client connects, the server handles authentication of 57 | this client, then it creates a transport and the connection on 58 | top of this transport. 59 | 60 | Note that connections passed to [f] are initially down. It is up 61 | to the user to set them up with {!OBus_connection.set_up}. *) 62 | 63 | val make_lowlevel : 64 | ?switch : Lwt_switch.t -> 65 | ?capabilities : OBus_auth.capability list -> 66 | ?mechanisms : OBus_auth.Server.mechanism list -> 67 | ?addresses : OBus_address.t list -> 68 | ?allow_anonymous : bool -> 69 | (t -> OBus_transport.t -> unit) -> t Lwt.t 70 | (** [make_lowlevel] is the same as {!make} except that [f] receives 71 | only the transport, and no connection is created for this 72 | transport. *) 73 | -------------------------------------------------------------------------------- /examples/signals.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * signals.ml 3 | * ---------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* This sample illustrate the use of signals *) 11 | 12 | open Lwt_react 13 | open Lwt 14 | open Lwt_io 15 | 16 | (* Add an handler on keyboard event which print the multimedia key 17 | pressed *) 18 | let handle_multimedia_keys device = 19 | OBus_signal.connect (Hal_device.condition device) 20 | >|= (E.map_p 21 | (fun (action, key) -> 22 | let%lwt () = printlf "from Hal: action %S on key %S!" action key in 23 | let%lwt () = printlf " the signal come from the device %S" (OBus_path.to_string (Hal_device.udi device)) in 24 | return ())) 25 | >|= E.keep 26 | 27 | let () = Lwt_main.run begin 28 | let%lwt session = OBus_bus.session () in 29 | 30 | (* +---------------------------------------------------------------+ 31 | | Signals from message bus | 32 | +---------------------------------------------------------------+ *) 33 | 34 | let%lwt () = 35 | OBus_signal.connect (OBus_bus.name_owner_changed session) 36 | >|= (E.map_p 37 | (fun (name, old_owner, new_owner) -> 38 | printlf "from D-Bus: the owner of the name %S changed: %S -> %S" 39 | name old_owner new_owner)) 40 | >|= E.keep 41 | in 42 | 43 | let%lwt () = 44 | OBus_signal.connect (OBus_bus.name_lost session) 45 | >|= E.map_p (printlf "from D-Bus: i lost the name %S!") 46 | >|= E.keep 47 | in 48 | 49 | let%lwt () = 50 | OBus_signal.connect (OBus_bus.name_acquired session) 51 | >|= E.map_p (printf "from D-Bus: i got the name '%S!") 52 | >|= E.keep 53 | in 54 | 55 | (* +---------------------------------------------------------------+ 56 | | Some Hal signals | 57 | +---------------------------------------------------------------+ *) 58 | 59 | let%lwt manager = Hal_manager.manager () in 60 | 61 | let%lwt () = 62 | OBus_signal.connect (Hal_manager.device_added manager) 63 | >|= (E.map_p 64 | (fun device -> 65 | let%lwt () = printlf "from Hal: device added: %S" (OBus_path.to_string (Hal_device.udi device)) in 66 | 67 | (* Handle the adding of keyboards *) 68 | Hal_device.query_capability device "input.keyboard" >>= function 69 | | true -> handle_multimedia_keys device 70 | | false -> return ())) 71 | >|= E.keep 72 | in 73 | 74 | (* Find all keyboards and handle events on them *) 75 | let%lwt keyboards = Hal_manager.find_device_by_capability manager "input.keyboard" in 76 | let%lwt () = printlf "keyboard founds: %d" (List.length keyboards) in 77 | let%lwt () = Lwt_list.iter_p (fun dev -> printlf " %s" (OBus_path.to_string (Hal_device.udi dev))) keyboards in 78 | 79 | let%lwt () = Lwt_list.iter_p handle_multimedia_keys keyboards in 80 | 81 | let%lwt () = printf "type Ctrl+C to stop\n%!" in 82 | fst (wait ()) 83 | end 84 | -------------------------------------------------------------------------------- /src/protocol/oBus_proxy.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_proxy.mli 3 | * -------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** Remote D-Bus objects *) 11 | 12 | (** A proxy is an object on which live on a different processus, but 13 | behave as a native ocaml value. *) 14 | 15 | (** The default type for proxies *) 16 | type t = { 17 | peer : OBus_peer.t; 18 | (** Peer owning the object *) 19 | 20 | path : OBus_path.t; 21 | (** Path of the object on the peer *) 22 | } 23 | 24 | val compare : t -> t -> int 25 | (** Same as [Stdlib.compare]. It allows this module to be used 26 | as argument to the functors [Set.Make] and [Map.Make]. *) 27 | 28 | val make : peer : OBus_peer.t -> path : OBus_path.t -> t 29 | (** Creates a proxy from the given peer and path *) 30 | 31 | (** {6 Informations} *) 32 | 33 | val peer : t -> OBus_peer.t 34 | (** Returns the peer pointed by a proxy *) 35 | 36 | val path : t -> OBus_path.t 37 | (** Returns the path of a proxy *) 38 | 39 | val connection : t -> OBus_connection.t 40 | (** [connection proxy = OBus_peer.connection (peer proxy)] *) 41 | 42 | val name : t -> OBus_name.bus 43 | (** [connection proxy = OBus_peer.name (peer proxy)] *) 44 | 45 | val introspect : t -> OBus_introspect.document Lwt.t 46 | (** [introspect proxy] introspects the given proxy *) 47 | 48 | (** {6 Method calls} *) 49 | 50 | val call : t -> 51 | interface : OBus_name.interface -> 52 | member : OBus_name.member -> 53 | i_args : 'a OBus_value.C.sequence -> 54 | o_args : 'b OBus_value.C.sequence -> 'a -> 'b Lwt.t 55 | (** [call proxy ~interface ~member ~i_args ~o_args args] calls the 56 | given method on the given proxy and wait for the reply. *) 57 | 58 | val call_with_context : t -> 59 | interface : OBus_name.interface -> 60 | member : OBus_name.member -> 61 | i_args : 'a OBus_value.C.sequence -> 62 | o_args : 'b OBus_value.C.sequence -> 'a -> (OBus_context.t * 'b) Lwt.t 63 | (** [call_with_context] is like {!call} except that is also returns 64 | the context of the method return *) 65 | 66 | val call_no_reply : t -> 67 | interface : OBus_name.interface -> 68 | member : OBus_name.member -> 69 | i_args : 'a OBus_value.C.sequence -> 'a -> unit Lwt.t 70 | (** [call_no_reply] is the same as {!call} except that it does not 71 | wait for a reply *) 72 | 73 | (** {6 Private proxies} *) 74 | 75 | (** The two following module interface and implementations are helpers 76 | for using private proxies. A private proxy is just a normal proxy 77 | but defined as a private type, to avoid incorrect use. *) 78 | 79 | type proxy = t 80 | 81 | (** Minimal interface of private proxies *) 82 | module type Private = sig 83 | type t = private proxy 84 | external of_proxy : proxy -> t = "%identity" 85 | external to_proxy : t -> proxy = "%identity" 86 | end 87 | 88 | (** Minimal implementation of private proxies *) 89 | module Private : sig 90 | type t = proxy 91 | external of_proxy : proxy -> t = "%identity" 92 | external to_proxy : t -> proxy = "%identity" 93 | end 94 | -------------------------------------------------------------------------------- /tests/test_serialization.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * test_serialization.ml 3 | * --------------------- 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* Testing of serialization/deserialization *) 11 | 12 | open Lwt 13 | open Lwt_io 14 | 15 | (* number of message to generate *) 16 | let test_count = 100 17 | 18 | type result = { 19 | success : int; 20 | (* Writing/reading succeed and original and resulting messages are equal *) 21 | failure : int; 22 | (* Writing/reading succeed but original and resulting messages are not equal *) 23 | reading_error : int; 24 | (* Failed to deserialize the message *) 25 | writing_error : int; 26 | (* Falied to serialize the message *) 27 | } 28 | 29 | let run_one_test byte_order msg acc = 30 | try 31 | let str, fds = OBus_wire.string_of_message ~byte_order msg in 32 | let msg' = OBus_wire.message_of_string str fds in 33 | if msg' = msg then 34 | { acc with success = acc.success + 1 } 35 | else begin 36 | { acc with failure = acc.failure + 1 } 37 | end 38 | with 39 | | OBus_wire.Data_error msg -> 40 | { acc with writing_error = acc.writing_error + 1 } 41 | | OBus_wire.Protocol_error msg -> 42 | { acc with reading_error = acc.reading_error + 1 } 43 | 44 | let run_tests prefix byte_order l = 45 | let%lwt progress = Progress.make prefix test_count in 46 | let rec aux acc n = function 47 | | [] -> 48 | let%lwt () = Progress.close progress in 49 | return acc 50 | | msg :: l -> 51 | let%lwt () = Progress.incr progress in 52 | aux (run_one_test byte_order msg acc) (n + 1) l 53 | in 54 | aux { success = 0; failure = 0; reading_error = 0; writing_error = 0 } 0 l 55 | 56 | let print_result result = 57 | let%lwt () = printf " success: %d\n" result.success in 58 | let%lwt () = printf " failure: %d\n" result.failure in 59 | let%lwt () = printf " writing error: %d\n" result.writing_error in 60 | let%lwt () = printf " reading error: %d\n" result.reading_error in 61 | return () 62 | 63 | let rec gen_messages progress acc = function 64 | | 0 -> 65 | let%lwt () = Progress.close progress in 66 | return acc 67 | | n -> 68 | let%lwt () = Progress.incr progress in 69 | gen_messages progress (Gen_random.message () :: acc) (n - 1) 70 | 71 | let test () = 72 | let%lwt progress = Progress.make (Printf.sprintf "generating %d messages" test_count) test_count in 73 | let%lwt msgs = gen_messages progress [] test_count in 74 | let%lwt () = printl "try to serialize/deserialize all messages and compare the result to the original message." in 75 | let%lwt result_le = run_tests " - in little endian" Lwt_io.Little_endian msgs in 76 | let%lwt () = print_result result_le in 77 | let%lwt result_be = run_tests " - in big endian" Lwt_io.Big_endian msgs in 78 | let%lwt () = print_result result_be in 79 | return (result_le.failure = 0 80 | && result_le.reading_error = 0 81 | && result_le.writing_error = 0 82 | && result_be.failure = 0 83 | && result_be.reading_error = 0 84 | && result_be.writing_error = 0) 85 | -------------------------------------------------------------------------------- /src/protocol/oBus_member.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_member.ml 3 | * -------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open OBus_introspect 11 | 12 | let introspect_arguments args = 13 | List.map2 14 | (fun name typ -> (name, typ)) 15 | (OBus_value.arg_names args) 16 | (OBus_value.C.type_sequence (OBus_value.arg_types args)) 17 | 18 | module Method = 19 | struct 20 | type ('a, 'b) t = { 21 | interface : OBus_name.interface; 22 | member : OBus_name.member; 23 | i_args : 'a OBus_value.arguments; 24 | o_args : 'b OBus_value.arguments; 25 | annotations : OBus_introspect.annotation list; 26 | } 27 | 28 | let make ~interface ~member ~i_args ~o_args ~annotations = { 29 | interface = interface; 30 | member = member; 31 | i_args = i_args; 32 | o_args = o_args; 33 | annotations = annotations; 34 | } 35 | 36 | let interface m = m.interface 37 | let member m = m.member 38 | let i_args m = m.i_args 39 | let o_args m = m.o_args 40 | let annotations m = m.annotations 41 | 42 | let introspect m = 43 | Method(m.member, introspect_arguments m.i_args, introspect_arguments m.o_args, m.annotations) 44 | end 45 | 46 | module Signal = 47 | struct 48 | type 'a t = { 49 | interface : OBus_name.interface; 50 | member : OBus_name.member; 51 | args : 'a OBus_value.arguments; 52 | annotations : OBus_introspect.annotation list; 53 | } 54 | 55 | let make ~interface ~member ~args ~annotations = { 56 | interface = interface; 57 | member = member; 58 | args = args; 59 | annotations = annotations; 60 | } 61 | 62 | let interface s = s.interface 63 | let member s = s.member 64 | let args s = s.args 65 | let annotations s = s.annotations 66 | 67 | let introspect s = 68 | Signal(s.member, introspect_arguments s.args, s.annotations) 69 | end 70 | 71 | module Property = 72 | struct 73 | type 'a access = 74 | | Readable 75 | | Writable 76 | | Readable_writable 77 | 78 | let readable = Readable 79 | let writable = Writable 80 | let readable_writable = Readable_writable 81 | 82 | type ('a, 'access) t = { 83 | interface : OBus_name.interface; 84 | member : OBus_name.member; 85 | typ : 'a OBus_value.C.single; 86 | access : 'access access; 87 | annotations : OBus_introspect.annotation list; 88 | } 89 | 90 | let make ~interface ~member ~typ ~access ~annotations = { 91 | interface = interface; 92 | member = member; 93 | typ = typ; 94 | access = access; 95 | annotations = annotations; 96 | } 97 | 98 | let interface p = p.interface 99 | let member p = p.member 100 | let typ p = p.typ 101 | let access p = p.access 102 | let annotations p = p.annotations 103 | 104 | let introspect p = 105 | Property(p.member, OBus_value.C.type_single p.typ, 106 | (match p.access with 107 | | Readable -> Read 108 | | Writable -> Write 109 | | Readable_writable -> Read_write), 110 | p.annotations) 111 | end 112 | -------------------------------------------------------------------------------- /src/internals/oBus_type_ext_lexer.mll: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_type_ext_lexer.mll 3 | * ----------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | { 11 | open OBus_value 12 | 13 | exception Fail of int * string 14 | 15 | let pos lexbuf = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum 16 | 17 | let fail lexbuf fmt = 18 | Printf.ksprintf 19 | (fun msg -> raise (Fail(pos lexbuf, msg))) 20 | fmt 21 | 22 | type term = 23 | | Term of string * term list 24 | | Tuple of term list 25 | 26 | let term name args = Term(name, args) 27 | let tuple = function 28 | | [t] -> t 29 | | l -> Tuple l 30 | } 31 | 32 | let int = ['-' '+']? ['0'-'9']+ 33 | let space = [' ' '\t' '\n'] 34 | let ident = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* 35 | 36 | rule enum_and_flag = parse 37 | | space* (ident as name) space* ":" (ident as typ) "=" 38 | { let typ = match typ with 39 | | "byte" -> T.Byte 40 | | "int16" -> T.Int16 41 | | "int32" -> T.Int32 42 | | "int64" -> T.Int64 43 | | "uint16" -> T.Uint16 44 | | "uint32" -> T.Uint32 45 | | "uint64" -> T.Uint64 46 | | _ -> fail lexbuf "invalid key type: %S" typ 47 | in 48 | let values = values typ lexbuf in 49 | eoi lexbuf; 50 | (name, typ, values) } 51 | | "" 52 | { fail lexbuf "syntax error" } 53 | 54 | and eoi = parse 55 | | space* eof { () } 56 | | "" { fail lexbuf "syntax error" } 57 | 58 | and values typ = parse 59 | | space* (int as key) space* ":" space* (ident as name) 60 | { 61 | let key = match typ with 62 | | T.Byte -> V.Byte(char_of_int (int_of_string key)) 63 | | T.Int16 -> V.Int16(int_of_string key) 64 | | T.Int32 -> V.Int32(Int32.of_string key) 65 | | T.Int64 -> V.Int64(Int64.of_string key) 66 | | T.Uint16 -> V.Uint16(int_of_string key) 67 | | T.Uint32 -> V.Uint32(Int32.of_string key) 68 | | T.Uint64 -> V.Uint64(Int64.of_string key) 69 | | _ -> assert false 70 | in 71 | if comma lexbuf then 72 | (key, name) :: values typ lexbuf 73 | else 74 | [(key, name)] 75 | } 76 | | "" 77 | { 78 | fail lexbuf "syntax error" 79 | } 80 | 81 | and comma = parse 82 | | space* "," { true } 83 | | "" { false } 84 | 85 | and single = parse 86 | | space* (ident as name) 87 | { term name [] } 88 | | space* "(" (ident as name) 89 | { term name (type_args lexbuf) } 90 | | space* "<" 91 | { tuple (tuple_args lexbuf) } 92 | | "" { fail lexbuf "syntax error" } 93 | 94 | and type_args = parse 95 | | space* ")" { [] } 96 | | "" { let typ = single lexbuf in typ :: type_args lexbuf } 97 | 98 | and tuple_args = parse 99 | | space* ">" { [] } 100 | | "" { let typ = single lexbuf in typ :: tuple_args2 lexbuf } 101 | 102 | and tuple_args2 = parse 103 | | space* ">" { [] } 104 | | space* "," { let typ = single lexbuf in typ :: tuple_args2 lexbuf } 105 | | "" { fail lexbuf "syntax error" } 106 | -------------------------------------------------------------------------------- /src/protocol/oBus_signal.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * oBus_signal.mli 3 | * --------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (** D-Bus signals *) 11 | 12 | (** {6 Emitting signals} *) 13 | 14 | val emit : 'a OBus_member.Signal.t -> 'b OBus_object.t -> ?peer : OBus_peer.t -> 'a -> unit Lwt.t 15 | (** [emit signal obj ?peer args] emits [signal] from [obj]. The 16 | destinations of the signal are selected as follow: 17 | 18 | - if [peer] is provided, then the message is sent only to it 19 | - otherwise, if the the object has an owner, it is sent to the owner, 20 | - otherwise, the message is broadcasted on all the connections [obj] 21 | is exported on. 22 | *) 23 | 24 | (** {6 Receving signals} *) 25 | 26 | type 'a t 27 | (** Type of a signal descriptor. A signal descriptor represent the 28 | source of a signal and describes how the value should be 29 | transformed. *) 30 | 31 | val make : 'a OBus_member.Signal.t -> OBus_proxy.t -> 'a t 32 | (** [make signal proxy] creates a signal descriptor. *) 33 | 34 | val make_any : 'a OBus_member.Signal.t -> OBus_peer.t -> (OBus_proxy.t * 'a) t 35 | (** [make_any signal peer] creates a signal descriptor for receiving 36 | signals from any object of [peer]. *) 37 | 38 | val connect : ?switch : Lwt_switch.t -> 'a t -> 'a React.event Lwt.t 39 | (** [connect ?switch sd] connects the signal descriptor [sd] and 40 | returns the event which occurs when the given D-Bus signal is 41 | received. *) 42 | 43 | (** {6 Signals transformations and parameters} *) 44 | 45 | val map_event : ((OBus_context.t * 'a) React.event -> (OBus_context.t * 'b) React.event) -> 'a t -> 'b t 46 | (** [map_event f sd] transforms with [f] the event that is created 47 | when [sd] is connected. *) 48 | 49 | val map : ('a -> 'b) -> 'a t -> 'b t 50 | (** Simplified version of {!map_event}. *) 51 | 52 | val map_with_context : (OBus_context.t -> 'a -> 'b) -> 'a t -> 'b t 53 | (** Same as {!map} but the mapping function also receive the 54 | context. *) 55 | 56 | val with_context : 'a t -> (OBus_context.t * 'a) t 57 | (** @return a signal descriptor that returns contexts in which 58 | signals are received. *) 59 | 60 | val with_filters : OBus_match.arguments -> 'a t -> 'a t 61 | (** [with_filters filters sd] is the signal descriptor [sd] with the 62 | given list of argument filters. When connected, obus will add 63 | this filters to the matching rule send to the message bus, so 64 | the bus can use them to drop messages that do not match these 65 | filters. 66 | 67 | The goal of argument filters is to reduce the number of messages 68 | received, and so to reduce the number of wakeup of the 69 | program. 70 | 71 | Note that match rule management must be activated for filters to 72 | take effect (see {!with_match_rule}). *) 73 | 74 | val with_match_rule : bool -> 'a t -> 'a t 75 | (** [with_match_rule state sd] enables or disables the automatic 76 | management of matching rules. If the endpoint of the underlying 77 | connection is a message bus it defaults to [true], otherwise it 78 | default to [false]. *) 79 | -------------------------------------------------------------------------------- /bindings/upower/uPower.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower.ml 3 | * --------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | 12 | include OBus_peer.Private 13 | 14 | let general_error = "org.freedesktop.UPower.GeneralError" 15 | 16 | let daemon () = 17 | let%lwt bus = OBus_bus.system () in 18 | return (OBus_peer.make bus "org.freedesktop.UPower") 19 | 20 | open UPower_interfaces.Org_freedesktop_UPower 21 | 22 | let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "UPower"] 23 | 24 | let enumerate_devices daemon = 25 | let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateDevices (proxy daemon) () in 26 | return 27 | (List.map 28 | (fun path -> 29 | UPower_device.of_proxy 30 | (OBus_proxy.make (OBus_context.sender context) path)) 31 | devices) 32 | 33 | let device_added daemon = 34 | OBus_signal.map_with_context 35 | (fun context device -> 36 | UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) 37 | (OBus_signal.make s_DeviceAdded (proxy daemon)) 38 | 39 | let device_removed daemon = 40 | OBus_signal.map_with_context 41 | (fun context device -> 42 | UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) 43 | (OBus_signal.make s_DeviceRemoved (proxy daemon)) 44 | 45 | let device_changed daemon = 46 | OBus_signal.map_with_context 47 | (fun context device -> 48 | UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) 49 | (OBus_signal.make s_DeviceChanged (proxy daemon)) 50 | 51 | let changed daemon = 52 | OBus_signal.make s_Changed (proxy daemon) 53 | 54 | let sleeping daemon = 55 | OBus_signal.make s_Sleeping (proxy daemon) 56 | 57 | let resuming daemon = 58 | OBus_signal.make s_Resuming (proxy daemon) 59 | 60 | let about_to_sleep daemon = 61 | OBus_method.call m_AboutToSleep (proxy daemon) () 62 | 63 | let suspend daemon = 64 | OBus_method.call m_Suspend (proxy daemon) () 65 | 66 | let suspend_allowed daemon = 67 | OBus_method.call m_SuspendAllowed (proxy daemon) () 68 | 69 | let hibernate daemon = 70 | OBus_method.call m_Hibernate (proxy daemon) () 71 | 72 | let hibernate_allowed daemon = 73 | OBus_method.call m_HibernateAllowed (proxy daemon) () 74 | 75 | let daemon_version daemon = 76 | OBus_property.make ~monitor:UPower_monitor.monitor p_DaemonVersion (proxy daemon) 77 | 78 | let can_suspend daemon = 79 | OBus_property.make ~monitor:UPower_monitor.monitor p_CanSuspend (proxy daemon) 80 | 81 | let can_hibernate daemon = 82 | OBus_property.make ~monitor:UPower_monitor.monitor p_CanHibernate (proxy daemon) 83 | 84 | let on_battery daemon = 85 | OBus_property.make ~monitor:UPower_monitor.monitor p_OnBattery (proxy daemon) 86 | 87 | let on_low_battery daemon = 88 | OBus_property.make ~monitor:UPower_monitor.monitor p_OnLowBattery (proxy daemon) 89 | 90 | let lid_is_closed daemon = 91 | OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsClosed (proxy daemon) 92 | 93 | let lid_is_present daemon = 94 | OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsPresent (proxy daemon) 95 | 96 | let properties daemon = 97 | OBus_property.group ~monitor:UPower_monitor.monitor (proxy daemon) interface 98 | -------------------------------------------------------------------------------- /tests/syntax_extension.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * syntax_extension.ml 3 | * ------------------- 4 | * Copyright : (c) 2009-2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | (* +-----------------------------------------------------------------+ 11 | | Type tests | 12 | +-----------------------------------------------------------------+ *) 13 | 14 | (* Functionnal type *) 15 | let typ = <:obus_func< string -> uint -> string -> string -> string -> string list -> (string, variant) assoc -> int -> uint >> 16 | 17 | (* Alias *) 18 | type t = int with obus 19 | 20 | (* Alias with type parameters *) 21 | type ('a, 'b, 'c) t = (int * 'a list) structure * ('c, 'b) balbla with obus 22 | 23 | module type M = sig 24 | (* Alias with type paramters in an interface *) 25 | type ('a, 'b, 'c) t = (int * 'a list) structure * ('c, 'b) balbla 26 | with obus(single -> basic -> basic -> container) 27 | end 28 | 29 | (* Automatic generation of a record combinator*) 30 | type foo = { 31 | a : A.B.string; 32 | b : int list; 33 | c : (int, string, char) machin; 34 | d : (int * byte_array * (int, string) dict_entry set) structure * int; 35 | } with obus 36 | 37 | (* Tuple *) 38 | let big_tuple = 39 | <:obus_type< int * string * uint * int32 * byte * char * int list * int * int * string * variant * signature >> 40 | 41 | (* Very big tuple *) 42 | let super_big_tuple = 43 | <: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 >> 44 | 45 | (* +-----------------------------------------------------------------+ 46 | | Exceptions | 47 | +-----------------------------------------------------------------+ *) 48 | 49 | exception Fatal_error of string 50 | with obus("org.foo.Error.FatalError") 51 | 52 | exception Simple_error of string 53 | with obus(prefix ^ ".SimpleError") 54 | 55 | (* +-----------------------------------------------------------------+ 56 | | Proxy code | 57 | +-----------------------------------------------------------------+ *) 58 | 59 | OP_method Plop : int 60 | OP_method Plop : int -> string 61 | OP_signal HaHaHa : string 62 | OP_property_r Foo : int list 63 | 64 | (* +-----------------------------------------------------------------+ 65 | | Proxy code with a custom proxy | 66 | +-----------------------------------------------------------------+ *) 67 | 68 | module Proxy = OBus_proxy.Make 69 | (struct 70 | type proxy = t 71 | let cast x = x.proxy 72 | let make x = failwith "not implemented" 73 | end) 74 | 75 | OP_method SetCPUFreqGovernor : string 76 | OP_method MethodWithLabels : x : int -> y : int -> str : string -> unit 77 | 78 | (* +-----------------------------------------------------------------+ 79 | | Object code | 80 | +-----------------------------------------------------------------+ *) 81 | 82 | OL_method Test : int -> int 83 | OL_method TestWithDefinition : int -> int = fun x -> x + 1 84 | OL_signal Foo : string * string 85 | OL_property_rw Prop : int = (fun obj -> return obj.x) (fun obj x -> obj.x <- x; return ()) 86 | -------------------------------------------------------------------------------- /utils/doc/style.css: -------------------------------------------------------------------------------- 1 | /* A style for ocamldoc. Daniel C. Buenzli, Jérémie Dimino */ 2 | 3 | body { 4 | padding: 0em; 5 | border: 0em; 6 | margin: 2em 10% 2em 10%; 7 | font-weight: normal; 8 | line-height: 130%; 9 | text-align: justify; 10 | background: white; 11 | color : black; 12 | min-width: 40ex; 13 | } 14 | 15 | pre, p, div, span, img, table, td, ol, ul, li { 16 | padding: 0em; 17 | border: 0em; 18 | margin: 0em 19 | } 20 | 21 | h1, h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 { 22 | fontsize: 100%; 23 | margin-bottom: 1em 24 | padding: 1ex 0em 0em 0em; 25 | border: 0em; 26 | margin: 1em 0em 0em 0em; 27 | font-weight : bold; 28 | text-align: center; 29 | } 30 | 31 | h1 { 32 | font-size : 140% 33 | } 34 | 35 | h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 { 36 | font-size : 100%; 37 | border-top-style : none; 38 | margin: 1ex 0em 0em 0em; 39 | border: 1px solid #000000; 40 | margin-top: 5px; 41 | margin-bottom: 2px; 42 | text-align: center; 43 | padding: 2px; 44 | } 45 | 46 | h2 { 47 | font-size : 120%; 48 | background-color: #90BDFF ; 49 | } 50 | h3 { 51 | background-color: #90DDFF; 52 | } 53 | h4 { 54 | background-color: #90EDFF; 55 | } 56 | h5 { 57 | background-color: #90FDFF; 58 | } 59 | h6 { 60 | background-color: #C0FFFF; 61 | } 62 | div.h7 { 63 | background-color: #E0FFFF; 64 | } 65 | div.h8 { 66 | background-color: #F0FFFF; 67 | } 68 | div.h9 { 69 | background-color: #FFFFFF; 70 | } 71 | 72 | .navbar { 73 | padding-bottom : 1em; 74 | margin-bottom: 1em; 75 | border-bottom: 1px solid #000000; 76 | border-bottom-style: dotted; 77 | } 78 | 79 | p { 80 | padding: 1em 0ex 0em 0em 81 | } 82 | 83 | a, a:link, a:visited, a:active, a:hover { 84 | color : #009; 85 | text-decoration: none 86 | } 87 | a:hover { 88 | color : #009; 89 | text-decoration : none; 90 | background-color: #5FFF88 91 | } 92 | 93 | hr { 94 | border-style: none; 95 | } 96 | table { 97 | font-size : 100% /* Why ? */ 98 | } 99 | ul li { 100 | padding: 1em 0em 0em 0em; 101 | margin:0em 0em 0em 2.5ex 102 | } 103 | ol li { 104 | padding: 1em 0em 0em 0em; 105 | margin:0em 0em 0em 2em 106 | } 107 | 108 | pre { 109 | margin: 3ex 0em 1ex 0em; 110 | background-color: #edf0f9; 111 | } 112 | .keyword { 113 | font-weight: bold; 114 | color: #a020f0; 115 | } 116 | .keywordsign { 117 | font-weight: bold; 118 | color: #a020f0; 119 | } 120 | .typefieldcomment { 121 | color : #b22222; 122 | } 123 | .keywordsign { 124 | color: #a020f0; 125 | 126 | } 127 | .code { 128 | font-size: 120%; 129 | color: #5f5f5f; 130 | } 131 | .info { 132 | margin: 0em 0em 0em 2em 133 | } 134 | .comment { 135 | color : #b22222; 136 | } 137 | .constructor { 138 | color : #072 139 | } 140 | .type { 141 | color : #228b22; 142 | } 143 | .string { 144 | color : #bc8f8f; 145 | } 146 | .warning { 147 | color : Red; 148 | font-weight : bold 149 | } 150 | 151 | div.sig_block { 152 | margin-left: 2em 153 | } 154 | .typetable { 155 | color : #b8860b; 156 | border-style : hidden 157 | } 158 | .indextable { 159 | border-style : hidden 160 | } 161 | .paramstable { 162 | border-style : hidden; 163 | padding: 5pt 5pt 164 | } 165 | 166 | .superscript { 167 | font-size : 80% 168 | } 169 | .subscript { 170 | font-size : 80% 171 | } 172 | -------------------------------------------------------------------------------- /bindings/upower/uPower_interfaces.obus: -------------------------------------------------------------------------------- 1 | (* 2 | * uPower_interfaces.obus 3 | * ---------------------- 4 | * Copyright : (c) 2010, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | interface org.freedesktop.UPower { 11 | method EnumerateDevices : () -> (devices : object_path array) 12 | 13 | (* Introspections files are wrong for this signals: 14 | 15 | signal DeviceAdded : (device : object_path) 16 | signal DeviceRemoved : (device : object_path) 17 | signal DeviceChanged : (device : object_path) *) 18 | 19 | signal DeviceAdded : (device : string) 20 | signal DeviceRemoved : (device : string) 21 | signal DeviceChanged : (device : string) 22 | 23 | signal Changed : () 24 | signal Sleeping : () 25 | signal Resuming : () 26 | method AboutToSleep : () -> () 27 | method Suspend : () -> () 28 | method SuspendAllowed : () -> (allowed : boolean) 29 | method Hibernate : () -> () 30 | method HibernateAllowed : () -> (allowed : boolean) 31 | property_r DaemonVersion : string 32 | property_r CanSuspend : boolean 33 | property_r CanHibernate : boolean 34 | property_r OnBattery : boolean 35 | property_r OnLowBattery : boolean 36 | property_r LidIsClosed : boolean 37 | property_r LidIsPresent : boolean 38 | } 39 | 40 | interface org.freedesktop.UPower.Device { 41 | method Refresh : () -> () 42 | signal Changed : () 43 | method GetHistory : (type : string, timespan : uint32, resolution : uint32) -> (data : (uint32 * double * uint32) array) 44 | method GetStatistics : (type : string) -> (data : (double * double) array) 45 | property_r NativePath : string 46 | property_r Vendor : string 47 | property_r Model : string 48 | property_r Serial : string 49 | property_r UpdateTime : uint64 50 | property_r Type : uint32 51 | property_r PowerSupply : boolean 52 | property_r HasHistory : boolean 53 | property_r HasStatistics : boolean 54 | property_r Online : boolean 55 | property_r Energy : double 56 | property_r EnergyEmpty : double 57 | property_r EnergyFull : double 58 | property_r EnergyFullDesign : double 59 | property_r EnergyRate : double 60 | property_r Voltage : double 61 | property_r TimeToEmpty : int64 62 | property_r TimeToFull : int64 63 | property_r Percentage : double 64 | property_r IsPresent : boolean 65 | property_r State : uint32 66 | property_r IsRechargeable : boolean 67 | property_r Capacity : double 68 | property_r Technology : uint32 69 | property_r RecallNotice : boolean 70 | property_r RecallVendor : string 71 | property_r RecallUrl : string 72 | } 73 | 74 | interface org.freedesktop.UPower.QoS { 75 | method SetMinimumLatency : (type : string, value : int32) -> () 76 | method RequestLatency : (type : string, value : int32, persistent : boolean) -> (cookie : uint32) 77 | method CancelRequest : (type : string, cookie : uint32) -> () 78 | method GetLatency : (type : string) -> (value : int32) 79 | signal LatencyChanged : (type : string, value : int32) 80 | method GetLatencyRequests : () -> (requests : (uint32 * uint32 * uint32 * string * int64 * boolean * string * string * int32) array) 81 | signal RequestsChanged : () 82 | } 83 | 84 | interface org.freedesktop.UPower.Wakeups { 85 | property_r HasCapability : boolean 86 | method GetTotal : () -> (value : uint32) 87 | signal TotalChanged : (value : uint32) 88 | method GetData : () -> (data : (boolean * uint32 * double * string * string) array) 89 | signal DataChanged : () 90 | } 91 | -------------------------------------------------------------------------------- /bindings/hal/hal_manager.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hal_manager.ml 3 | * -------------- 4 | * Copyright : (c) 2009, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | open Lwt 11 | open OBus_value 12 | 13 | include OBus_proxy.Private 14 | 15 | 16 | let manager () = 17 | let%lwt bus = OBus_bus.system () in 18 | return (OBus_proxy.make 19 | (OBus_peer.make bus "org.freedesktop.Hal") 20 | [ "org"; "freedesktop"; "Hal"; "Manager" ]) 21 | 22 | open Hal_interfaces.Org_freedesktop_Hal_Manager 23 | 24 | let make_device context udi = 25 | Hal_device.of_proxy 26 | (OBus_proxy.make (OBus_context.sender context) 27 | (OBus_path.of_string udi)) 28 | 29 | let get_all_devices proxy = 30 | let%lwt context, l = OBus_method.call_with_context m_GetAllDevices proxy () in 31 | return (List.map (make_device context) l) 32 | 33 | let get_all_devices_with_properties proxy = 34 | let%lwt context, l = OBus_method.call_with_context m_GetAllDevicesWithProperties proxy () in 35 | return (List.map 36 | (fun (udi, properties) -> 37 | (make_device context udi, 38 | List.map (fun (name, value) -> (name, Hal_device.property_of_variant value)) properties)) 39 | l) 40 | 41 | let device_exists proxy udi = 42 | OBus_method.call m_DeviceExists proxy (OBus_path.to_string udi) 43 | 44 | let find_device_string_match proxy key value = 45 | let%lwt context, l = OBus_method.call_with_context m_FindDeviceStringMatch proxy (key, value) in 46 | return (List.map (make_device context) l) 47 | 48 | let find_device_by_capability proxy capability = 49 | let%lwt context, l = OBus_method.call_with_context m_FindDeviceByCapability proxy capability in 50 | return (List.map (make_device context) l) 51 | 52 | let new_device proxy = 53 | let%lwt context, udi = OBus_method.call_with_context m_NewDevice proxy () in 54 | return (make_device context udi) 55 | 56 | let remove proxy dev = 57 | OBus_method.call m_Remove proxy (OBus_path.to_string (Hal_device.udi dev)) 58 | 59 | let commit_to_gdl proxy temporary_udi global_udi = 60 | OBus_method.call m_CommitToGdl proxy (temporary_udi, global_udi) 61 | 62 | let acquire_global_interface_lock proxy interface_name exclusive = 63 | OBus_method.call m_AcquireGlobalInterfaceLock proxy (interface_name, exclusive) 64 | 65 | let release_global_interface_lock proxy interface_name = 66 | OBus_method.call m_ReleaseGlobalInterfaceLock proxy interface_name 67 | 68 | let singleton_addon_is_ready proxy command_line = 69 | OBus_method.call m_SingletonAddonIsReady proxy command_line 70 | 71 | let device_added proxy = 72 | OBus_signal.map_with_context 73 | make_device 74 | (OBus_signal.make s_DeviceAdded proxy) 75 | 76 | let device_removed proxy = 77 | OBus_signal.map_with_context 78 | make_device 79 | (OBus_signal.make s_DeviceRemoved proxy) 80 | 81 | let new_capability proxy = 82 | OBus_signal.map_with_context 83 | (fun context (udi, cap) -> (make_device context udi, cap)) 84 | (OBus_signal.make s_NewCapability proxy) 85 | 86 | let global_interface_lock_acquired proxy = 87 | OBus_signal.map 88 | (fun (interface_name, lock_holder, num_locks) -> 89 | let num_locks = Int32.to_int num_locks in 90 | (interface_name, lock_holder, num_locks)) 91 | (OBus_signal.make s_GlobalInterfaceLockAcquired proxy) 92 | 93 | let global_interface_lock_released proxy = 94 | OBus_signal.map 95 | (fun (interface_name, lock_holder, num_locks) -> 96 | let num_locks = Int32.to_int num_locks in 97 | (interface_name, lock_holder, num_locks)) 98 | (OBus_signal.make s_GlobalInterfaceLockReleased proxy) 99 | -------------------------------------------------------------------------------- /tools/introspection/obus_introspect.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * obus_introspect.ml 3 | * ------------------ 4 | * Copyright : (c) 2008, Jeremie Dimino 5 | * Licence : BSD3 6 | * 7 | * This file is a part of obus, an ocaml implementation of D-Bus. 8 | *) 9 | 10 | let recursive = ref false 11 | let anons = ref [] 12 | let session = ref false 13 | let system = ref false 14 | let address = ref None 15 | let obj_mode = ref false 16 | 17 | let args = [ 18 | "-rec", Arg.Set recursive, "introspect recursively all sub-nodes"; 19 | "-session", Arg.Set session, "the service is on the session bus (the default)"; 20 | "-system", Arg.Set system, "the service is on the system bus"; 21 | "-address", Arg.String (fun addr -> address := Some addr), "the service is on the given message bus"; 22 | "-objects", Arg.Set obj_mode, "list objects with interfaces they implements instead of interfaces"; 23 | ] 24 | 25 | let usage_msg = Printf.sprintf "Usage: %s