diff options
Diffstat (limited to 'bindings')
66 files changed, 5734 insertions, 0 deletions
diff --git a/bindings/hal/dune b/bindings/hal/dune new file mode 100644 index 0000000..7e9e8db --- /dev/null +++ b/bindings/hal/dune @@ -0,0 +1,12 @@ +(library + (name obus_hal) + (public_name obus.hal) + (wrapped false) + (libraries lwt obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets hal_interfaces.ml hal_interfaces.mli) + (deps hal_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o hal_interfaces %{deps}))) diff --git a/bindings/hal/hal_device.ml b/bindings/hal/hal_device.ml new file mode 100644 index 0000000..40ae375 --- /dev/null +++ b/bindings/hal/hal_device.ml @@ -0,0 +1,337 @@ +(* + * hal_device.ml + * ------------- + * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt +open OBus_value +open Hal_interfaces + +include OBus_proxy.Private + +type udi = OBus_path.t + +let udi = OBus_proxy.path + +let computer () = + let%lwt bus = OBus_bus.system () in + return (OBus_proxy.make + (OBus_peer.make bus "org.freedesktop.Hal") + ["org"; "freedesktop"; "Hal"; "devices"; "computer"]) + + +type property = + | Pstring of string + | Pstrlist of string list + | Pint of int32 + | Puint64 of int64 + | Pbool of bool + | Pdouble of float + +let property_of_variant = function + | V.Basic(V.String s) -> Pstring s + | V.Array(T.Basic T.String, _) as l -> Pstrlist(C.cast_single (C.array C.basic_string) l) + | V.Basic(V.Int32 x) -> Pint x + | V.Basic(V.Uint64 x) -> Puint64 x + | V.Basic(V.Boolean x) -> Pbool x + | V.Basic(V.Double x) -> Pdouble x + | v -> Printf.ksprintf failwith "Hal_device.property_of_variant: invalid device property: %s" (V.string_of_single v) + +let variant_of_property = function + | Pstring s -> V.basic_string s + | Pstrlist l -> C.make_single (C.array C.basic_string) l + | Pint x -> V.basic_int32 x + | Puint64 x -> V.basic_uint64 x + | Pbool x -> V.basic_boolean x + | Pdouble x -> V.basic_double x + +open Org_freedesktop_Hal_Device + +let get_all_properties proxy = + let%lwt l = OBus_method.call m_GetAllProperties proxy () in + return (List.map (fun (name, value) -> (name, property_of_variant value)) l) + +let set_multiple_properties proxy properties = + OBus_method.call m_SetMultipleProperties proxy + (List.map (fun (name, property) -> (name, variant_of_property property)) properties) + +let get_property proxy key = + OBus_method.call m_GetProperty proxy key >|= property_of_variant + +let get_property_string proxy key = + OBus_method.call m_GetPropertyString proxy key + +let get_property_string_list proxy key = + OBus_method.call m_GetPropertyStringList proxy key + +let get_property_integer proxy key = + let%lwt value = OBus_method.call m_GetPropertyInteger proxy key in + let value = Int32.to_int value in + return value + +let get_property_boolean proxy key = + OBus_method.call m_GetPropertyBoolean proxy key + +let get_property_double proxy key = + OBus_method.call m_GetPropertyDouble proxy key + +let set_property proxy key value = + OBus_method.call m_SetProperty proxy (key, variant_of_property value) + +let set_property_string proxy key value = + OBus_method.call m_SetPropertyString proxy (key, value) + +let set_property_string_list proxy key value = + OBus_method.call m_SetPropertyStringList proxy (key, value) + +let set_property_integer proxy key value = + let value = Int32.of_int value in + OBus_method.call m_SetPropertyInteger proxy (key, value) + +let set_property_boolean proxy key value = + OBus_method.call m_SetPropertyBoolean proxy (key, value) + +let set_property_double proxy key value = + OBus_method.call m_SetPropertyDouble proxy (key, value) + +let remove_property proxy key = + OBus_method.call m_RemoveProperty proxy key + +let get_property_type proxy key = + let%lwt typ = OBus_method.call m_GetPropertyType proxy key in + let typ = Int32.to_int typ in + return typ + +let property_exists proxy key = + OBus_method.call m_PropertyExists proxy key + +let add_capability proxy capability = + OBus_method.call m_AddCapability proxy capability + +let query_capability proxy capability = + OBus_method.call m_QueryCapability proxy capability + +let lock proxy reason = + OBus_method.call m_Lock proxy reason + +let unlock proxy = + OBus_method.call m_Unlock proxy () + +let acquire_interface_lock proxy interface_name exclusive = + OBus_method.call m_AcquireInterfaceLock proxy (interface_name, exclusive) + +let release_interface_lock proxy interface_name = + OBus_method.call m_ReleaseInterfaceLock proxy interface_name + +let is_caller_locked_out proxy interface_name caller_sysbus_name = + OBus_method.call m_IsCallerLockedOut proxy (interface_name, caller_sysbus_name) + +let is_caller_privileged proxy action caller_sysbus_name = + OBus_method.call m_IsCallerPrivileged proxy (action, caller_sysbus_name) + +let is_locked_by_others proxy interface_name = + OBus_method.call m_IsLockedByOthers proxy interface_name + +let string_list_append proxy key value = + OBus_method.call m_StringListAppend proxy (key, value) + +let string_list_prepend proxy key value = + OBus_method.call m_StringListPrepend proxy (key, value) + +let string_list_remove proxy key value = + OBus_method.call m_StringListRemove proxy (key, value) + +let emit_condition proxy condition_name condition_details = + OBus_method.call m_EmitCondition proxy (condition_name, condition_details) + +let rescan proxy = + OBus_method.call m_Rescan proxy () + +let reprobe proxy = + OBus_method.call m_Reprobe proxy () + +let claim_interface proxy interface_name introspection_xml = + OBus_method.call m_ClaimInterface proxy (interface_name, introspection_xml) + +let addon_is_ready proxy = + OBus_method.call m_AddonIsReady proxy () + +let property_modified proxy = + OBus_signal.map + (fun (num_updates, updates) -> + let num_updates = Int32.to_int num_updates in + (num_updates, updates)) + (OBus_signal.make s_PropertyModified proxy) + +let condition proxy = + OBus_signal.make s_Condition proxy + +let interface_lock_acquired proxy = + OBus_signal.map + (fun (interface_name, lock_holder, num_locks) -> + let num_locks = Int32.to_int num_locks in + (interface_name, lock_holder, num_locks)) + (OBus_signal.make s_InterfaceLockAcquired proxy) + +let interface_lock_released proxy = + OBus_signal.map + (fun (interface_name, lock_holder, num_locks) -> + let num_locks = Int32.to_int num_locks in + (interface_name, lock_holder, num_locks)) + (OBus_signal.make s_InterfaceLockReleased proxy) + +module Volume = struct + open Org_freedesktop_Hal_Device_Volume + + let mount proxy mount_point fstype extra_options = + let%lwt return_code = OBus_method.call m_Mount proxy (mount_point, fstype, extra_options) in + let return_code = Int32.to_int return_code in + return return_code + + let unmount proxy extra_options = + let%lwt return_code = OBus_method.call m_Unmount proxy extra_options in + let return_code = Int32.to_int return_code in + return return_code + + let eject proxy extra_options = + let%lwt return_code = OBus_method.call m_Eject proxy extra_options in + let return_code = Int32.to_int return_code in + return return_code +end + +module Storage = struct + open Org_freedesktop_Hal_Device_Storage + + let eject proxy extra_options = + let%lwt return_code = OBus_method.call m_Eject proxy extra_options in + let return_code = Int32.to_int return_code in + return return_code + + let close_tray proxy extra_options = + let%lwt return_code = OBus_method.call m_CloseTray proxy extra_options in + let return_code = Int32.to_int return_code in + return return_code +end + +module Storage_removable = struct + open Org_freedesktop_Hal_Device_Storage_Removable + + let check_for_media proxy = + OBus_method.call m_CheckForMedia proxy () +end + +module Wake_on_lan = struct + open Org_freedesktop_Hal_Device_WakeOnLan + + let get_supported proxy = + let%lwt return_code = OBus_method.call m_GetSupported proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let get_enabled proxy = + let%lwt return_code = OBus_method.call m_GetEnabled proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let set_enabled proxy enable = + let%lwt return_code = OBus_method.call m_SetEnabled proxy enable in + let return_code = Int32.to_int return_code in + return return_code +end + +module System_power_management = struct + open Org_freedesktop_Hal_Device_SystemPowerManagement + + let suspend proxy num_seconds_to_sleep = + let num_seconds_to_sleep = Int32.of_int num_seconds_to_sleep in + let%lwt return_code = OBus_method.call m_Suspend proxy num_seconds_to_sleep in + let return_code = Int32.to_int return_code in + return return_code + + let suspend_hybrid proxy num_seconds_to_sleep = + let num_seconds_to_sleep = Int32.of_int num_seconds_to_sleep in + let%lwt return_code = OBus_method.call m_SuspendHybrid proxy num_seconds_to_sleep in + let return_code = Int32.to_int return_code in + return return_code + + let hibernate proxy = + let%lwt return_code = OBus_method.call m_Hibernate proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let shutdown proxy = + let%lwt return_code = OBus_method.call m_Shutdown proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let reboot proxy = + let%lwt return_code = OBus_method.call m_Reboot proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let set_power_save proxy enable_power_save = + let%lwt return_code = OBus_method.call m_SetPowerSave proxy enable_power_save in + let return_code = Int32.to_int return_code in + return return_code +end + +module Cpufreq = struct + open Org_freedesktop_Hal_Device_CPUFreq + + let set_cpufreq_governor proxy governor_string = + OBus_method.call m_SetCPUFreqGovernor proxy governor_string + + let set_cpufreq_performance proxy value = + let value = Int32.of_int value in + OBus_method.call m_SetCPUFreqPerformance proxy value + + let set_cpufreq_consider_nice proxy value = + OBus_method.call m_SetCPUFreqConsiderNice proxy value + + let get_cpufreq_governor proxy = + OBus_method.call m_GetCPUFreqGovernor proxy () + + let get_cpufreq_performance proxy = + let%lwt return_code = OBus_method.call m_GetCPUFreqPerformance proxy () in + let return_code = Int32.to_int return_code in + return return_code + + let get_cpufreq_consider_nice proxy = + OBus_method.call m_GetCPUFreqConsiderNice proxy () + + let get_cpufreq_available_governors proxy = + OBus_method.call m_GetCPUFreqAvailableGovernors proxy () +end + +module Laptop_panel = struct + open Org_freedesktop_Hal_Device_LaptopPanel + + let set_brightness proxy brightness_value = + let brightness_value = Int32.of_int brightness_value in + let%lwt return_code = OBus_method.call m_SetBrightness proxy brightness_value in + let return_code = Int32.to_int return_code in + return return_code + + let get_brightness proxy = + let%lwt brightness_value = OBus_method.call m_GetBrightness proxy () in + let brightness_value = Int32.to_int brightness_value in + return brightness_value +end + +module Kill_switch = struct + open Org_freedesktop_Hal_Device_KillSwitch + + let set_power proxy value = + let%lwt return_code = OBus_method.call m_SetPower proxy value in + let return_code = Int32.to_int return_code in + return return_code + + let get_power proxy = + let%lwt value = OBus_method.call m_GetPower proxy () in + let value = Int32.to_int value in + return value +end diff --git a/bindings/hal/hal_device.mli b/bindings/hal/hal_device.mli new file mode 100644 index 0000000..b02a382 --- /dev/null +++ b/bindings/hal/hal_device.mli @@ -0,0 +1,135 @@ +(* + * hal_device.mli + * -------------- + * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Hal devices *) + +include OBus_proxy.Private + +type udi = OBus_path.t + (** Unique Device Identifier *) + +val udi : t -> udi + (** Return the udi of a device *) + +val computer : unit -> t Lwt.t + (** The computer device *) + +type property = + (** A device property *) + | Pstring of string + (** An UTF8 string *) + | Pstrlist of string list + (** List of UTF8 strings *) + | Pint of int32 + (** 32-bit signed integer *) + | Puint64 of int64 + (** 64-bit unsigned integer *) + | Pbool of bool + | Pdouble of float + (** IEEE754 double precision floating point number *) + +val property_of_variant : OBus_value.V.single -> property + (** Tries to convert the given variant into a property *) + +val variant_of_property : property -> OBus_value.V.single + (** Converts the gievn property into a D-Bus variant *) + +(** {6 Common device interface} *) + +val get_all_properties : t -> (string * property) list Lwt.t +val set_multiple_properties : t -> (string * property) list -> unit Lwt.t +val get_property : t -> string -> property Lwt.t +val get_property_string : t -> string -> string Lwt.t +val get_property_string_list : t -> string -> string list Lwt.t +val get_property_integer : t -> string -> int Lwt.t +val get_property_boolean : t -> string -> bool Lwt.t +val get_property_double : t -> string -> float Lwt.t +val set_property : t -> string -> property -> unit Lwt.t +val set_property_string : t -> string -> string -> unit Lwt.t +val set_property_string_list : t -> string -> string list -> unit Lwt.t +val set_property_integer : t -> string -> int -> unit Lwt.t +val set_property_boolean : t -> string -> bool -> unit Lwt.t +val set_property_double : t -> string -> float -> unit Lwt.t +val remove_property : t -> string -> unit Lwt.t +val get_property_type : t -> string -> int Lwt.t +val property_exists : t -> string -> bool Lwt.t +val add_capability : t -> string -> unit Lwt.t +val query_capability : t -> string -> bool Lwt.t +val lock : t -> string -> bool Lwt.t +val unlock : t -> bool Lwt.t +val acquire_interface_lock : t -> string -> bool -> unit Lwt.t +val release_interface_lock : t -> string -> unit Lwt.t +val is_caller_locked_out : t -> string -> string -> bool Lwt.t +val is_caller_privileged : t -> string -> string -> string Lwt.t +val is_locked_by_others : t -> string -> bool Lwt.t +val string_list_append : t -> string -> string -> unit Lwt.t +val string_list_prepend : t -> string -> string -> unit Lwt.t +val string_list_remove : t -> string -> string -> unit Lwt.t +val emit_condition : t -> string -> string -> bool Lwt.t +val rescan : t -> bool Lwt.t +val reprobe : t -> bool Lwt.t +val claim_interface : t -> string -> string -> bool Lwt.t +val addon_is_ready : t -> bool Lwt.t + +val property_modified : t -> (int * (string * bool * bool) list) OBus_signal.t +val condition : t -> (string * string) OBus_signal.t +val interface_lock_acquired : t -> (string * string * int) OBus_signal.t +val interface_lock_released : t -> (string * string * int) OBus_signal.t + +(** {6 Specifics interfaces} *) + +module Volume : sig + val mount : t -> string -> string -> string list -> int Lwt.t + val unmount : t -> string list -> int Lwt.t + val eject : t -> string list -> int Lwt.t +end + +module Storage : sig + val eject : t -> string list -> int Lwt.t + val close_tray : t -> string list -> int Lwt.t +end + +module Storage_removable : sig + val check_for_media : t -> bool Lwt.t +end + +module Wake_on_lan : sig + val get_supported : t -> int Lwt.t + val get_enabled : t -> int Lwt.t + val set_enabled : t -> bool -> int Lwt.t +end + +module System_power_management : sig + val suspend : t -> int -> int Lwt.t + val suspend_hybrid : t -> int -> int Lwt.t + val hibernate : t -> int Lwt.t + val shutdown : t -> int Lwt.t + val reboot : t -> int Lwt.t + val set_power_save : t -> bool -> int Lwt.t +end + +module Cpufreq : sig + val set_cpufreq_governor : t -> string -> unit Lwt.t + val set_cpufreq_performance : t -> int -> unit Lwt.t + val set_cpufreq_consider_nice : t -> bool -> unit Lwt.t + val get_cpufreq_governor : t -> string Lwt.t + val get_cpufreq_performance : t -> int Lwt.t + val get_cpufreq_consider_nice : t -> bool Lwt.t + val get_cpufreq_available_governors : t -> string list Lwt.t +end + +module Laptop_panel : sig + val set_brightness : t -> int -> int Lwt.t + val get_brightness : t -> int Lwt.t +end + +module Kill_switch : sig + val set_power : t -> bool -> int Lwt.t + val get_power : t -> int Lwt.t +end diff --git a/bindings/hal/hal_interfaces.obus b/bindings/hal/hal_interfaces.obus new file mode 100644 index 0000000..7a8198c --- /dev/null +++ b/bindings/hal/hal_interfaces.obus @@ -0,0 +1,128 @@ +(* + * hal_interfaces.obus + * ------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.Hal.Device { + method GetAllProperties : () -> (properties : (string, variant) dict) + method SetMultipleProperties : (properties : (string, variant) dict) -> () + method GetProperty : (key : string) -> (value : variant) + method GetPropertyString : (key : string) -> (value : string) + method GetPropertyStringList : (key : string) -> (value : string array) + method GetPropertyInteger : (key : string) -> (value : int32) + method GetPropertyBoolean : (key : string) -> (value : boolean) + method GetPropertyDouble : (key : string) -> (value : double) + method SetProperty : (key : string, value : variant) -> () + method SetPropertyString : (key : string, value : string) -> () + method SetPropertyStringList : (key : string, value : string array) -> () + method SetPropertyInteger : (key : string, value : int32) -> () + method SetPropertyBoolean : (key : string, value : boolean) -> () + method SetPropertyDouble : (key : string, value : double) -> () + method RemoveProperty : (key : string) -> () + method GetPropertyType : (key : string) -> (type : int32) + method PropertyExists : (key : string) -> (does_it_exist : boolean) + method AddCapability : (capability : string) -> () + method QueryCapability : (capability : string) -> (does_it_have_capability : boolean) + method Lock : (reason : string) -> (acquired_lock : boolean) + method Unlock : () -> (released_lock : boolean) + method AcquireInterfaceLock : (interface_name : string, exclusive : boolean) -> () + method ReleaseInterfaceLock : (interface_name : string) -> () + method IsCallerLockedOut : (interface_name : string, caller_sysbus_name : string) -> (whether_caller_is_locked_out : boolean) + method IsCallerPrivileged : (action : string, caller_sysbus_name : string) -> (result : string) + method IsLockedByOthers : (interface_name : string) -> (whether_it_is_locked_by_others : boolean) + method StringListAppend : (key : string, value : string) -> () + method StringListPrepend : (key : string, value : string) -> () + method StringListRemove : (key : string, value : string) -> () + method EmitCondition : (condition_name : string, condition_details : string) -> (rc : boolean) + method Rescan : () -> (call_had_sideeffect : boolean) + method Reprobe : () -> (call_had_sideeffect : boolean) + method ClaimInterface : (interface_name : string, introspection_xml : string) -> (rc : boolean) + method AddonIsReady : () -> (rc : boolean) + signal PropertyModified : (num_updates : int32, updates : (string * boolean * boolean) array) + signal Condition : (cond_name : string, cond_details : string) + signal InterfaceLockAcquired : (interface_name : string, lock_holder : string, num_locks : int32) + signal InterfaceLockReleased : (interface_name : string, lock_holder : string, num_locks : int32) +} + +interface org.freedesktop.Hal.Device.CPUFreq { + method SetCPUFreqGovernor : (governor_string : string) -> () + method SetCPUFreqPerformance : (value : int32) -> () + method SetCPUFreqConsiderNice : (value : boolean) -> () + method GetCPUFreqGovernor : () -> (return_code : string) + method GetCPUFreqPerformance : () -> (return_code : int32) + method GetCPUFreqConsiderNice : () -> (return_code : boolean) + method GetCPUFreqAvailableGovernors : () -> (return_code : string array) +} + +interface org.freedesktop.Hal.Device.KillSwitch { + method SetPower : (value : boolean) -> (return_code : int32) + method GetPower : () -> (value : int32) +} + +interface org.freedesktop.Hal.Device.LaptopPanel { + method SetBrightness : (brightness_value : int32) -> (return_code : int32) + method GetBrightness : () -> (brightness_value : int32) +} + +interface org.freedesktop.Hal.Device.Leds { + method SetBrightness : (brightness_value : int32) -> (return_code : int32) + method GetBrightness : () -> (brightness_value : int32) +} + +interface org.freedesktop.Hal.Device.Storage { + method Eject : (options : string array) -> (result : int32) + method CloseTray : (options : string array) -> (result : int32) +} + +interface org.freedesktop.Hal.Device.Storage.Removable { + method CheckForMedia : () -> (call_had_sideeffect : boolean) +} + +interface org.freedesktop.Hal.Device.SystemPowerManagement { + method Suspend : (num_seconds_to_sleep : int32) -> (return_code : int32) + method SuspendHybrid : (num_seconds_to_sleep : int32) -> (return_code : int32) + method Hibernate : () -> (return_code : int32) + method Shutdown : () -> (return_code : int32) + method Reboot : () -> (return_code : int32) + method SetPowerSave : (enable_power_save : boolean) -> (return_code : int32) +} + +interface org.freedesktop.Hal.Device.Volume { + method Mount : (mount_point : string, fstype : string, options : string array) -> (result : int32) + method Unmount : (options : string array) -> (result : int32) + method Eject : (options : string array) -> (result : int32) +} + +interface org.freedesktop.Hal.Device.Volume.Crypto { + method Setup : (passphrase : string) -> (result : int32) + method Teardown : () -> (result : int32) +} + +interface org.freedesktop.Hal.Device.WakeOnLan { + method GetSupported : () -> (return_code : int32) + method GetEnabled : () -> (return_code : int32) + method SetEnabled : (enable : boolean) -> (return_code : int32) +} + +interface org.freedesktop.Hal.Manager { + method GetAllDevices : () -> (devices : string array) + method GetAllDevicesWithProperties : () -> (devices_with_props : (string * (string, variant) dict) array) + method DeviceExists : (udi : string) -> (does_it_exist : boolean) + method FindDeviceStringMatch : (key : string, value : string) -> (devices : string array) + method FindDeviceByCapability : (capability : string) -> (devices : string array) + method NewDevice : () -> (temporary_udi : string) + method Remove : (udi : string) -> () + method CommitToGdl : (temporary_udi : string, global_udi : string) -> () + method AcquireGlobalInterfaceLock : (interface_name : string, exclusive : boolean) -> () + method ReleaseGlobalInterfaceLock : (interface_name : string) -> () + method SingletonAddonIsReady : (command_line : string) -> () + signal DeviceAdded : (udi : string) + signal DeviceRemoved : (udi : string) + signal NewCapability : (udi : string, cap_name : string) + signal GlobalInterfaceLockAcquired : (interface_name : string, lock_holder : string, num_locks : int32) + signal GlobalInterfaceLockReleased : (interface_name : string, lock_holder : string, num_locks : int32) +} diff --git a/bindings/hal/hal_manager.ml b/bindings/hal/hal_manager.ml new file mode 100644 index 0000000..64ca3df --- /dev/null +++ b/bindings/hal/hal_manager.ml @@ -0,0 +1,98 @@ +(* + * hal_manager.ml + * -------------- + * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt +open OBus_value + +include OBus_proxy.Private + + +let manager () = + let%lwt bus = OBus_bus.system () in + return (OBus_proxy.make + (OBus_peer.make bus "org.freedesktop.Hal") + [ "org"; "freedesktop"; "Hal"; "Manager" ]) + +open Hal_interfaces.Org_freedesktop_Hal_Manager + +let make_device context udi = + Hal_device.of_proxy + (OBus_proxy.make (OBus_context.sender context) + (OBus_path.of_string udi)) + +let get_all_devices proxy = + let%lwt context, l = OBus_method.call_with_context m_GetAllDevices proxy () in + return (List.map (make_device context) l) + +let get_all_devices_with_properties proxy = + let%lwt context, l = OBus_method.call_with_context m_GetAllDevicesWithProperties proxy () in + return (List.map + (fun (udi, properties) -> + (make_device context udi, + List.map (fun (name, value) -> (name, Hal_device.property_of_variant value)) properties)) + l) + +let device_exists proxy udi = + OBus_method.call m_DeviceExists proxy (OBus_path.to_string udi) + +let find_device_string_match proxy key value = + let%lwt context, l = OBus_method.call_with_context m_FindDeviceStringMatch proxy (key, value) in + return (List.map (make_device context) l) + +let find_device_by_capability proxy capability = + let%lwt context, l = OBus_method.call_with_context m_FindDeviceByCapability proxy capability in + return (List.map (make_device context) l) + +let new_device proxy = + let%lwt context, udi = OBus_method.call_with_context m_NewDevice proxy () in + return (make_device context udi) + +let remove proxy dev = + OBus_method.call m_Remove proxy (OBus_path.to_string (Hal_device.udi dev)) + +let commit_to_gdl proxy temporary_udi global_udi = + OBus_method.call m_CommitToGdl proxy (temporary_udi, global_udi) + +let acquire_global_interface_lock proxy interface_name exclusive = + OBus_method.call m_AcquireGlobalInterfaceLock proxy (interface_name, exclusive) + +let release_global_interface_lock proxy interface_name = + OBus_method.call m_ReleaseGlobalInterfaceLock proxy interface_name + +let singleton_addon_is_ready proxy command_line = + OBus_method.call m_SingletonAddonIsReady proxy command_line + +let device_added proxy = + OBus_signal.map_with_context + make_device + (OBus_signal.make s_DeviceAdded proxy) + +let device_removed proxy = + OBus_signal.map_with_context + make_device + (OBus_signal.make s_DeviceRemoved proxy) + +let new_capability proxy = + OBus_signal.map_with_context + (fun context (udi, cap) -> (make_device context udi, cap)) + (OBus_signal.make s_NewCapability proxy) + +let global_interface_lock_acquired proxy = + OBus_signal.map + (fun (interface_name, lock_holder, num_locks) -> + let num_locks = Int32.to_int num_locks in + (interface_name, lock_holder, num_locks)) + (OBus_signal.make s_GlobalInterfaceLockAcquired proxy) + +let global_interface_lock_released proxy = + OBus_signal.map + (fun (interface_name, lock_holder, num_locks) -> + let num_locks = Int32.to_int num_locks in + (interface_name, lock_holder, num_locks)) + (OBus_signal.make s_GlobalInterfaceLockReleased proxy) diff --git a/bindings/hal/hal_manager.mli b/bindings/hal/hal_manager.mli new file mode 100644 index 0000000..b49d04d --- /dev/null +++ b/bindings/hal/hal_manager.mli @@ -0,0 +1,33 @@ +(* + * hal_manager.mli + * --------------- + * Copyright : (c) 2009, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** The Hal manager *) + +include OBus_proxy.Private + +val manager : unit -> t Lwt.t + (** The Hal manager *) + +val get_all_devices : t -> Hal_device.t list Lwt.t +val get_all_devices_with_properties : t -> (Hal_device.t * (string * Hal_device.property) list) list Lwt.t +val device_exists : t -> Hal_device.udi -> bool Lwt.t +val find_device_string_match : t -> string -> string -> Hal_device.t list Lwt.t +val find_device_by_capability : t -> string -> Hal_device.t list Lwt.t +val new_device : t -> Hal_device.t Lwt.t +val remove : t -> Hal_device.t -> unit Lwt.t +val commit_to_gdl : t -> string -> string -> unit Lwt.t +val acquire_global_interface_lock : t -> string -> bool -> unit Lwt.t +val release_global_interface_lock : t -> string -> unit Lwt.t +val singleton_addon_is_ready : t -> string -> unit Lwt.t + +val device_added : t -> Hal_device.t OBus_signal.t +val device_removed : t -> Hal_device.t OBus_signal.t +val new_capability : t -> (Hal_device.t * string) OBus_signal.t +val global_interface_lock_acquired : t -> (string * string * int) OBus_signal.t +val global_interface_lock_released : t -> (string * string * int) OBus_signal.t diff --git a/bindings/network-manager/dune b/bindings/network-manager/dune new file mode 100644 index 0000000..456dbff --- /dev/null +++ b/bindings/network-manager/dune @@ -0,0 +1,12 @@ +(library + (name obus_network_manager) + (public_name obus.network_manager) + (wrapped false) + (libraries lwt lwt_log obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets nm_interfaces.ml nm_interfaces.mli) + (deps nm_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o nm_interfaces %{deps}))) diff --git a/bindings/network-manager/nm_access_point.ml b/bindings/network-manager/nm_access_point.ml new file mode 100644 index 0000000..85ca05d --- /dev/null +++ b/bindings/network-manager/nm_access_point.ml @@ -0,0 +1,95 @@ +(* + * nm_access_point.ml + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +open Lwt + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_AccessPoint + +type ap_flag = + [ `Privacy ] + +let flags proxy = + OBus_property.map_r + (fun n -> if (Int32.to_int n) land 0x01 <> 0 then [`Privacy] else []) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Flags proxy) + +type ap_security_flag = + [ `Pair_wep40 + | `Pair_wep104 + | `Pair_tkip + | `Pair_ccmp + | `Group_wep40 + | `Group_wep104 + | `Group_tkip + | `Group_ccmp + | `Key_mgmt_psk + | `Key_mgmt_802_1x ] + +let ap_security_flags_of_int32 n = + let n = Int32.to_int n in + let add l bit_mask flag = + if n land bit_mask <> 0 then + flag :: l + else + l + in + let l = [] in + let l = add l 0x001 `Pair_wep40 in + let l = add l 0x002 `Pair_wep104 in + let l = add l 0x004 `Pair_tkip in + let l = add l 0x008 `Pair_ccmp in + let l = add l 0x010 `Group_wep40 in + let l = add l 0x020 `Group_wep104 in + let l = add l 0x040 `Group_tkip in + let l = add l 0x080 `Group_ccmp in + let l = add l 0x100 `Key_mgmt_psk in + let l = add l 0x200 `Key_mgmt_802_1x in + l + +let wpa_flags proxy = + OBus_property.map_r + ap_security_flags_of_int32 + (OBus_property.make ~monitor:Nm_monitor.monitor p_WpaFlags proxy) + +let rsn_flags proxy = + OBus_property.map_r + ap_security_flags_of_int32 + (OBus_property.make ~monitor:Nm_monitor.monitor p_RsnFlags proxy) + +let ssid proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Ssid proxy + +let frequency proxy = + OBus_property.map_r + Int32.to_int + (OBus_property.make ~monitor:Nm_monitor.monitor p_Frequency proxy) + +let hw_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy + +let mode proxy = + OBus_property.map_r + Int32.to_int + (OBus_property.make ~monitor:Nm_monitor.monitor p_Mode proxy) + +let max_bitrate proxy = + OBus_property.map_r + Int32.to_int + (OBus_property.make ~monitor:Nm_monitor.monitor p_MaxBitrate proxy) + +let strength proxy = + OBus_property.map_r + int_of_char + (OBus_property.make ~monitor:Nm_monitor.monitor p_Strength proxy) + +let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface diff --git a/bindings/network-manager/nm_access_point.mli b/bindings/network-manager/nm_access_point.mli new file mode 100644 index 0000000..320c9cf --- /dev/null +++ b/bindings/network-manager/nm_access_point.mli @@ -0,0 +1,59 @@ +(* + * nm_access_point.mli + * ------------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Access point interface *) + +include OBus_proxy.Private + +(** {6 Signals} *) + +val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + +(** {6 Properties} *) + +type ap_flag = + [ `Privacy (** Access point supports privacy measures. *) ] + +val flags : t -> ap_flag list OBus_property.r + +type ap_security_flag = + [ `Pair_wep40 + (** Access point supports pairwise 40-bit WEP encryption *) + | `Pair_wep104 + (** Access point supports pairwise 104-bit WEP encryption *) + | `Pair_tkip + (** Access point supports pairwise TKIP encryption *) + | `Pair_ccmp + (** Access point supports pairwise CCMP encryption *) + | `Group_wep40 + (** Access point supports a group 40-bit WEP cipher *) + | `Group_wep104 + (** Access point supports a group 104-bit WEP cipher *) + | `Group_tkip + (** Access point supports a group TKIP cipher *) + | `Group_ccmp + (** Access point supports a group CCMP cipher *) + | `Key_mgmt_psk + (** Access point supports PSK key management *) + | `Key_mgmt_802_1x + (** Access point supports 802.1x key management *) ] + +val wpa_flags : t -> ap_security_flag list OBus_property.r +val rsn_flags : t -> ap_security_flag list OBus_property.r + +val ssid : t -> string OBus_property.r + +val frequency : t -> int OBus_property.r +val hw_address : t -> string OBus_property.r +val mode : t -> int OBus_property.r +val max_bitrate : t -> int OBus_property.r +val strength : t -> int OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_connection.ml b/bindings/network-manager/nm_connection.ml new file mode 100644 index 0000000..dc23ea1 --- /dev/null +++ b/bindings/network-manager/nm_connection.ml @@ -0,0 +1,67 @@ +(* + * nm_connection.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +open Lwt + +let section = Lwt_log.Section.make "network-manager(connection)" + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_Connection_Active + +type state = + [ `Unknown + | `Activating + | `Activated ] + +let service_name proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_ServiceName proxy + +let connection proxy = + OBus_property.map_r_with_context + (fun context x -> + Nm_settings.Connection.of_proxy + (OBus_proxy.make (OBus_context.sender context) x)) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Connection proxy) + +let specific_object proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_SpecificObject proxy) + +let devices proxy = + OBus_property.map_r_with_context + (fun context paths -> + List.map + (fun path -> + Nm_device.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + paths) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Devices proxy) + +let state proxy = + OBus_property.map_r + (function + | 0l -> `Unknown + | 1l -> `Activating + | 2l -> `Activated + | st -> + ignore (Lwt_log.warning_f ~section "Nm_connection.state: unknown state: %ld" st); + `Unknown) + (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy) + +let default proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Default proxy + +let vpn proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Vpn proxy + +let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface diff --git a/bindings/network-manager/nm_connection.mli b/bindings/network-manager/nm_connection.mli new file mode 100644 index 0000000..fd3bce8 --- /dev/null +++ b/bindings/network-manager/nm_connection.mli @@ -0,0 +1,40 @@ +(* + * nm_connection.mli + * ----------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** NetworkManager active connections *) + +(** An active connection is a connection that is currently being used *) + +include OBus_proxy.Private + +(** The connection state *) +type state = + [ `Unknown + (** The active connection is in an unknown state. *) + | `Activating + (** The connection is activating. *) + | `Activated + (** The connection is activated. *) ] + +(** {6 Signals} *) + +val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + +(** {6 Properties} *) + +val service_name : t -> string OBus_property.r +val connection : t -> Nm_settings.Connection.t OBus_property.r +val specific_object : t -> OBus_proxy.t OBus_property.r +val devices : t -> Nm_device.t list OBus_property.r +val state : t -> state OBus_property.r +val default : t -> bool OBus_property.r +val vpn : t -> bool OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_device.ml b/bindings/network-manager/nm_device.ml new file mode 100644 index 0000000..1c00a45 --- /dev/null +++ b/bindings/network-manager/nm_device.ml @@ -0,0 +1,389 @@ +(* + * nm_device.ml + * ------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +open Lwt + +let section = Lwt_log.Section.make "network-manager(device)" + +include OBus_proxy.Private + +type state = + [ `Unknown + | `Unmanaged + | `Unavailable + | `Disconnected + | `Prepare + | `Config + | `Need_auth + | `Ip_config + | `Activated + | `Failed ] + +type state_reason = + [ `Unknown + | `None + | `Now_managed + | `Now_unmanaged + | `Config_failed + | `Config_unavailable + | `Config_expired + | `No_secrets + | `Supplicant_disconnect + | `Supplicant_config_failed + | `Supplicant_failed + | `Supplicant_timeout + | `Ppp_start_failed + | `Ppp_disconnect + | `Ppp_failed + | `Dhcp_start_failed + | `Dhcp_error + | `Dhcp_failed + | `Shared_start_failed + | `Shared_failed + | `Autoip_start_failed + | `Autoip_error + | `Autoip_failed + | `Modem_busy + | `Modem_no_dial_tone + | `Modem_no_carrier + | `Modem_dial_timeout + | `Modem_dial_failed + | `Modem_init_failed + | `Gsm_apn_failed + | `Gsm_registration_not_searching + | `Gsm_registration_denied + | `Gsm_registration_timeout + | `Gsm_registration_failed + | `Gsm_pin_check_failed + | `Firmware_missing + | `Removed + | `Sleeping + | `Connection_removed + | `User_requested + | `Carrier + | `Connection_assumed + | `Supplicant_available ] + +type typ = + [ `Unknown + | `Ethernet + | `Wifi + | `Gsm + | `Cdma ] + +type capability = + [ `Nm_supported + | `Carrier_detect ] + +let state_of_int32 = function + | 0l -> `Unknown + | 1l -> `Unmanaged + | 2l -> `Unavailable + | 3l -> `Disconnected + | 4l -> `Prepare + | 5l -> `Config + | 6l -> `Need_auth + | 7l -> `Ip_config + | 8l -> `Activated + | 9l -> `Failed + | st -> + ignore (Lwt_log.warning_f ~section "Nm_device.state_of_int32: unknown device_state: %ld" st); + `Unknown + +let state_reason_of_int32 = function + | 0l -> `Unknown + | 1l -> `None + | 2l -> `Now_managed + | 3l -> `Now_unmanaged + | 4l -> `Config_failed + | 5l -> `Config_unavailable + | 6l -> `Config_expired + | 7l -> `No_secrets + | 8l -> `Supplicant_disconnect + | 9l -> `Supplicant_config_failed + | 10l -> `Supplicant_failed + | 11l -> `Supplicant_timeout + | 12l -> `Ppp_start_failed + | 13l -> `Ppp_disconnect + | 14l -> `Ppp_failed + | 15l -> `Dhcp_start_failed + | 16l -> `Dhcp_error + | 17l -> `Dhcp_failed + | 18l -> `Shared_start_failed + | 19l -> `Shared_failed + | 20l -> `Autoip_start_failed + | 21l -> `Autoip_error + | 22l -> `Autoip_failed + | 23l -> `Modem_busy + | 24l -> `Modem_no_dial_tone + | 25l -> `Modem_no_carrier + | 26l -> `Modem_dial_timeout + | 27l -> `Modem_dial_failed + | 28l -> `Modem_init_failed + | 29l -> `Gsm_apn_failed + | 30l -> `Gsm_registration_not_searching + | 31l -> `Gsm_registration_denied + | 32l -> `Gsm_registration_timeout + | 33l -> `Gsm_registration_failed + | 34l -> `Gsm_pin_check_failed + | 35l -> `Firmware_missing + | 36l -> `Removed + | 37l -> `Sleeping + | 38l -> `Connection_removed + | 39l -> `User_requested + | 40l -> `Carrier + | 41l -> `Connection_assumed + | 42l -> `Supplicant_available + | n -> + ignore (Lwt_log.warning_f ~section "Nm_device.state_reason_of_int32: unknown state_reason: %ld" n); + `Unknown + +open Nm_interfaces.Org_freedesktop_NetworkManager_Device + +let udi proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Udi proxy + +let interface proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Interface proxy + +let driver proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Driver proxy + +let capabilities proxy = + OBus_property.map_r + (fun n -> + let n = Int32.to_int n in + let l = [] in + let l = if n land 0x1 <> 0 then `Nm_supported :: l else l in + let l = if n land 0x2 <> 0 then `Carrier_detect :: l else l in + l) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Capabilities proxy) + +let ip4_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Ip4Address proxy + +let state proxy = + OBus_property.map_r + state_of_int32 + (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy) + +let ip4_config proxy = + OBus_property.map_r_with_context + (fun context path -> + Nm_ip4_config.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Ip4Config proxy) + +let dhcp4_config proxy = + OBus_property.map_r_with_context + (fun context path -> + Nm_dhcp4_config.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Dhcp4Config proxy) + +let ip6_config proxy = + OBus_property.map_r_with_context + (fun context path -> + Nm_ip6_config.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Ip6Config proxy) + +let managed proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Managed proxy + +let device_type proxy = + OBus_property.map_r + (function + | 0l -> `Unknown + | 1l -> `Ethernet + | 2l -> `Wifi + | 3l -> `Gsm + | 4l -> `Cdma + | n -> + ignore (Lwt_log.warning_f ~section "device_type_of_int: unknown type: %ld" n); + `Unknown) + (OBus_property.make ~monitor:Nm_monitor.monitor p_DeviceType proxy) + +let disconnect proxy = + OBus_method.call m_Disconnect proxy () + +let state_changed proxy = + OBus_signal.map + (fun (new_state, old_state, reason) -> + (state_of_int32 new_state, + state_of_int32 old_state, + state_reason_of_int32 reason)) + (OBus_signal.make s_StateChanged proxy) + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy Nm_interfaces.Org_freedesktop_NetworkManager_Device.interface + +module Bluetooth = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Bluetooth + + let hw_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy + + let name proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Name proxy + + let bt_capabilities proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_BtCapabilities proxy) + + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + + let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface +end + +module Cdma = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Cdma + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy +end + +module Gsm = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Gsm + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy +end + +module Olpc_mesh = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_OlpcMesh + + let hw_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy + + let companion proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Companion proxy) + + let active_channel proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveChannel proxy) + + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + + let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface +end + +module Serial = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Serial + + let ppp_stats proxy = + OBus_signal.map + (fun (in_bytes, out_bytes) -> + let in_bytes = Int32.to_int in_bytes in + let out_bytes = Int32.to_int out_bytes in + (in_bytes, out_bytes)) + (OBus_signal.make s_PppStats proxy) +end + +module Wired = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Wired + + let hw_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy + + let speed proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Speed proxy) + + let carrier proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Carrier proxy + + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + + let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface +end + +module Wireless = +struct + open Nm_interfaces.Org_freedesktop_NetworkManager_Device_Wireless + + type wireless_capability = + [ `Cipher_wep40 + | `Cipher_wep104 + | `Cipher_tkip + | `Cipher_ccmp + | `Wpa + | `Rsn ] + + type wifi_mode = + [ `Unknown + | `Adhoc + | `Infra ] + + let get_access_points proxy = + let%lwt (context, access_points) = OBus_method.call_with_context m_GetAccessPoints proxy () in + return ( + List.map + (fun path -> + Nm_access_point.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + access_points + ) + + let hw_address proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_HwAddress proxy + + let mode proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Mode proxy) + + let bitrate proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Bitrate proxy) + + let active_access_point proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveAccessPoint proxy) + + let wireless_capabilities proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessCapabilities proxy) + + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + + let access_point_added proxy = + OBus_signal.map_with_context + (fun context access_point -> + Nm_access_point.of_proxy + (OBus_proxy.make (OBus_context.sender context) access_point)) + (OBus_signal.make s_AccessPointAdded proxy) + + let access_point_removed proxy = + OBus_signal.map_with_context + (fun context access_point -> + Nm_access_point.of_proxy + (OBus_proxy.make (OBus_context.sender context) access_point)) + (OBus_signal.make s_AccessPointRemoved proxy) + + let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface +end diff --git a/bindings/network-manager/nm_device.mli b/bindings/network-manager/nm_device.mli new file mode 100644 index 0000000..dd78035 --- /dev/null +++ b/bindings/network-manager/nm_device.mli @@ -0,0 +1,251 @@ +(* + * nm_device.mli + * ------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** NetworkManager devices *) + +include OBus_proxy.Private + +(** {6 Common interface} *) + +(** {8 Types} *) + +type state = + [ `Unknown + (** The device is in an unknown state. *) + | `Unmanaged + (** The device is not managed by NetworkManager. *) + | `Unavailable + (** The device cannot be used (carrier off, rfkill, etc) *) + | `Disconnected + (** The device is not connected. *) + | `Prepare + (** The device is preparing to connect. *) + | `Config + (** The device is being configured. *) + | `Need_auth + (** The device is awaiting secrets necessary to continue connection. *) + | `Ip_config + (** The IP settings of the device are being requested and configured. *) + | `Activated + (** The device is active. *) + | `Failed + (** The device is in a failure state following an attempt to activate it. *) ] + +type state_reason = + [ `Unknown + (** The reason for the device state change is unknown. *) + | `None + (** The state change is normal. *) + | `Now_managed + (** The device is now managed. *) + | `Now_unmanaged + (** The device is no longer managed. *) + | `Config_failed + (** The device could not be readied for configuration. *) + | `Config_unavailable + (** IP configuration could not be reserved (no available address, timeout, etc). *) + | `Config_expired + (** The IP configuration is no longer valid. *) + | `No_secrets + (** Secrets were required, but not provided. *) + | `Supplicant_disconnect + (** The 802.1X supplicant disconnected from the access point or authentication server. *) + | `Supplicant_config_failed + (** Configuration of the 802.1X supplicant failed. *) + | `Supplicant_failed + (** The 802.1X supplicant quit or failed unexpectedly. *) + | `Supplicant_timeout + (** The 802.1X supplicant took too long to authenticate. *) + | `Ppp_start_failed + (** The PPP service failed to start within the allowed time. *) + | `Ppp_disconnect + (** The PPP service disconnected unexpectedly. *) + | `Ppp_failed + (** The PPP service quit or failed unexpectedly. *) + | `Dhcp_start_failed + (** The DHCP service failed to start within the allowed time. *) + | `Dhcp_error + (** The DHCP service reported an unexpected error. *) + | `Dhcp_failed + (** The DHCP service quit or failed unexpectedly. *) + | `Shared_start_failed + (** The shared connection service failed to start. *) + | `Shared_failed + (** The shared connection service quit or failed unexpectedly. *) + | `Autoip_start_failed + (** The AutoIP service failed to start. *) + | `Autoip_error + (** The AutoIP service reported an unexpected error. *) + | `Autoip_failed + (** The AutoIP service quit or failed unexpectedly. *) + | `Modem_busy + (** Dialing failed because the line was busy. *) + | `Modem_no_dial_tone + (** Dialing failed because there was no dial tone. *) + | `Modem_no_carrier + (** Dialing failed because there was carrier. *) + | `Modem_dial_timeout + (** Dialing timed out. *) + | `Modem_dial_failed + (** Dialing failed. *) + | `Modem_init_failed + (** Modem initialization failed. *) + | `Gsm_apn_failed + (** Failed to select the specified GSM APN. *) + | `Gsm_registration_not_searching + (** Not searching for networks. *) + | `Gsm_registration_denied + (** Network registration was denied. *) + | `Gsm_registration_timeout + (** Network registration timed out. *) + | `Gsm_registration_failed + (** Failed to register with the requested GSM network. *) + | `Gsm_pin_check_failed + (** PIN check failed. *) + | `Firmware_missing + (** Necessary firmware for the device may be missing. *) + | `Removed + (** The device was removed. *) + | `Sleeping + (** NetworkManager went to sleep. *) + | `Connection_removed + (** The device's active connection was removed or disappeared. *) + | `User_requested + (** A user or client requested the disconnection. *) + | `Carrier + (** The device's carrier/link changed. *) + | `Connection_assumed + (** The device's existing connection was assumed. *) + | `Supplicant_available + (** The 802.1x supplicant is now available. *) ] + +type typ = + [ `Unknown + (** The device type is unknown. *) + | `Ethernet + (** The device is wired Ethernet device. *) + | `Wifi + (** The device is an 802.11 WiFi device. *) + | `Gsm + (** The device is a GSM-based cellular WAN device. *) + | `Cdma + (** The device is a CDMA/IS-95-based cellular WAN device. *) ] + +type capability = + [ `Nm_supported + (** The device is supported by NetworkManager. *) + | `Carrier_detect + (** The device supports carrier detection. *) ] + +(** {8 Methods} *) + +val disconnect : t -> unit Lwt.t + +(** {8 Signals} *) + +val state_changed : t -> (state * state * state_reason) OBus_signal.t + +(** {8 Properties} *) + +val udi : t -> string OBus_property.r +val interface : t -> string OBus_property.r +val driver : t -> string OBus_property.r +val capabilities : t -> capability list OBus_property.r +val ip4_address : t -> int32 OBus_property.r +val state : t -> state OBus_property.r +val ip4_config : t -> Nm_ip4_config.t OBus_property.r +val dhcp4_config : t -> Nm_dhcp4_config.t OBus_property.r +val ip6_config : t -> Nm_ip6_config.t OBus_property.r +val managed : t -> bool OBus_property.r +val device_type : t -> typ OBus_property.r + +val properties : t -> OBus_property.group + +(** {6 Specific device interfaces} *) + +module Bluetooth : sig + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + + val hw_address : t -> string OBus_property.r + val name : t -> string OBus_property.r + val bt_capabilities : t -> int OBus_property.r + + val properties : t -> OBus_property.group +end + +module Cdma : sig + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t +end + +module Gsm : sig + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t +end + +module Olpc_mesh : sig + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + + val hw_address : OBus_proxy.t -> (string, [ `readable ]) OBus_property.t + val companion : OBus_proxy.t -> (OBus_proxy.t, [ `readable ]) OBus_property.t + val active_channel : OBus_proxy.t -> (int, [ `readable ]) OBus_property.t + + val properties : t -> OBus_property.group +end + +module Serial : sig + val ppp_stats : t -> (int * int) OBus_signal.t +end + +module Wired : sig + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + + val hw_address : t -> string OBus_property.r + val speed : t -> int OBus_property.r + val carrier : t -> bool OBus_property.r + + val properties : t -> OBus_property.group +end + +module Wireless : sig + type wireless_capability = + [ `Cipher_wep40 + (** The device supports the 40-bit WEP cipher. *) + | `Cipher_wep104 + (** The device supports the 104-bit WEP cipher. *) + | `Cipher_tkip + (** The device supports the TKIP cipher. *) + | `Cipher_ccmp + (** The device supports the CCMP cipher. *) + | `Wpa + (** The device supports the WPA encryption/authentication protocol. *) + | `Rsn + (** The device supports the RSN encryption/authentication protocol. *) ] + + type wifi_mode = + [ `Unknown + (** Mode is unknown. *) + | `Adhoc + (** Uncoordinated network without central infrastructure. *) + | `Infra + (** Coordinated network with one or more central controllers. *) ] + + val get_access_points : t -> Nm_access_point.t list Lwt.t + + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + val access_point_added : t -> Nm_access_point.t OBus_signal.t + val access_point_removed : t -> Nm_access_point.t OBus_signal.t + + val hw_address : t -> string OBus_property.r + val mode : t -> int OBus_property.r + val bitrate : t -> int OBus_property.r + val active_access_point : t -> OBus_proxy.t OBus_property.r + val wireless_capabilities : t -> int OBus_property.r + + val properties : t -> OBus_property.group +end diff --git a/bindings/network-manager/nm_dhcp4_config.ml b/bindings/network-manager/nm_dhcp4_config.ml new file mode 100644 index 0000000..757fc4a --- /dev/null +++ b/bindings/network-manager/nm_dhcp4_config.ml @@ -0,0 +1,16 @@ +(* + * nm_dhcp4_config.ml + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_DHCP4Config + +let options proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Options proxy + +let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy diff --git a/bindings/network-manager/nm_dhcp4_config.mli b/bindings/network-manager/nm_dhcp4_config.mli new file mode 100644 index 0000000..6919383 --- /dev/null +++ b/bindings/network-manager/nm_dhcp4_config.mli @@ -0,0 +1,15 @@ +(* + * nm_dhcp4_config.mli + * ------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** DHCP4 configuration *) + +include OBus_proxy.Private + +val options : t -> (string * OBus_value.V.single) list OBus_property.r +val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t diff --git a/bindings/network-manager/nm_interfaces.obus b/bindings/network-manager/nm_interfaces.obus new file mode 100644 index 0000000..ccbd6ec --- /dev/null +++ b/bindings/network-manager/nm_interfaces.obus @@ -0,0 +1,183 @@ +(* + * nm_interfaces.obus + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.NetworkManager { + method GetDevices : () -> (devices : object_path array) + method ActivateConnection : (service_name : string, connection : object_path, device : object_path, specific_object : object_path) -> (active_connection : object_path) + method DeactivateConnection : (active_connection : object_path) -> () + method Sleep : (sleep : boolean) -> () + property_rw WirelessEnabled : boolean + property_r WirelessHardwareEnabled : boolean + property_rw WwanEnabled : boolean + property_r WwanHardwareEnabled : boolean + property_r ActiveConnections : object_path array + property_r State : uint32 + signal StateChanged : (state : uint32) + signal PropertiesChanged : (properties : (string, variant) dict) + signal DeviceAdded : (state : object_path) + signal DeviceRemoved : (state : object_path) +} + +interface org.freedesktop.NetworkManager.AccessPoint { + property_r Flags : uint32 + property_r WpaFlags : uint32 + property_r RsnFlags : uint32 + property_r Ssid : byte array + property_r Frequency : uint32 + property_r HwAddress : string + property_r Mode : uint32 + property_r MaxBitrate : uint32 + property_r Strength : byte + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Connection.Active { + property_r ServiceName : string + property_r Connection : object_path + property_r SpecificObject : object_path + property_r Devices : object_path array + property_r State : uint32 + property_r Default : boolean + property_r Vpn : boolean + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.DHCP4Config { + property_r Options : (string, variant) dict + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device { + property_r Udi : string + property_r Interface : string + property_r Driver : string + property_r Capabilities : uint32 + property_r Ip4Address : uint32 + property_r State : uint32 + property_r Ip4Config : object_path + property_r Dhcp4Config : object_path + property_r Ip6Config : object_path + property_r Managed : boolean + property_r DeviceType : uint32 + method Disconnect : () -> () + signal StateChanged : (new_state : uint32, old_state : uint32, reason : uint32) +} + +interface org.freedesktop.NetworkManager.Device.Bluetooth { + property_r HwAddress : string + property_r Name : string + property_r BtCapabilities : uint32 + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device.Cdma { + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device.Gsm { + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device.OlpcMesh { + property_r HwAddress : string + property_r Companion : object_path + property_r ActiveChannel : uint32 + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device.Serial { + signal PppStats : (in_bytes : uint32, out_bytes : uint32) +} + +interface org.freedesktop.NetworkManager.Device.Wired { + property_r HwAddress : string + property_r Speed : uint32 + property_r Carrier : boolean + signal PropertiesChanged : (properties : (string, variant) dict) +} + +interface org.freedesktop.NetworkManager.Device.Wireless { + method GetAccessPoints : () -> (access_points : object_path array) + property_r HwAddress : string + property_r Mode : uint32 + property_r Bitrate : uint32 + property_r ActiveAccessPoint : object_path + property_r WirelessCapabilities : uint32 + signal PropertiesChanged : (properties : (string, variant) dict) + signal AccessPointAdded : (access_point : object_path) + signal AccessPointRemoved : (access_point : object_path) +} + +interface org.freedesktop.NetworkManager.IP4Config { + property_r Addresses : (uint32 array) array + property_r Nameservers : uint32 array + property_r WinsServers : uint32 array + property_r Domains : string array + property_r Routes : (uint32 array) array +} + +interface org.freedesktop.NetworkManager.IP6Config { + property_r Addresses : (byte array * uint32) array + property_r Nameservers : (byte array) array + property_r Domains : string array + property_r Routes : (byte array * uint32 * byte array * uint32) array +} + +interface org.freedesktop.NetworkManager.PPP { + method NeedSecrets : () -> (username : string, password : string) + method SetIp4Config : (config : (string, variant) dict) -> () + method SetState : (state : uint32) -> () +} + +interface org.freedesktop.NetworkManager.VPN.Connection { + signal PropertiesChanged : (properties : (string, variant) dict) + property_r VpnState : uint32 + property_r Banner : string + signal VpnStateChanged : (state : uint32, reason : uint32) +} + +interface org.freedesktop.NetworkManager.VPN.Plugin { + method Connect : (connection : (string, (string, variant) dict) dict) -> () + method NeedSecrets : (settings : (string, (string, variant) dict) dict) -> (setting_name : string) + method Disconnect : () -> () + method SetIp4Config : (config : (string, variant) dict) -> () + method SetFailure : (reason : string) -> () + property_r State : uint32 + signal StateChanged : (state : uint32) + signal Ip4Config : (ip4config : (string, variant) dict) + signal LoginBanner : (banner : string) + signal Failure : (reason : uint32) +} + +interface org.freedesktop.NetworkManagerSettings { + method ListConnections : () -> (connections : object_path array) + method AddConnection : (connection : (string, (string, variant) dict) dict) -> () + signal NewConnection : (connection : object_path) +} + +interface org.freedesktop.NetworkManagerSettings.Connection { + method Update : (properties : (string, (string, variant) dict) dict) -> () + method Delete : () -> () + method GetSettings : () -> (settings : (string, (string, variant) dict) dict) + signal Updated : (settings : (string, (string, variant) dict) dict) + signal Removed : () +} + +interface org.freedesktop.NetworkManagerSettings.Connection.Secrets { + method GetSecrets : (setting_name : string, hints : string array, request_new : boolean) -> (secrets : (string, (string, variant) dict) dict) +} + +interface org.freedesktop.NetworkManagerSettings.System { + method SaveHostname : (hostname : string) -> () + property_r Hostname : string + property_r CanModify : boolean + signal PropertiesChanged : (properties : (string, variant) dict) + signal CheckPermissions : () + method GetPermissions : () -> (permissions : uint32) +} diff --git a/bindings/network-manager/nm_ip4_config.ml b/bindings/network-manager/nm_ip4_config.ml new file mode 100644 index 0000000..d6dd30d --- /dev/null +++ b/bindings/network-manager/nm_ip4_config.ml @@ -0,0 +1,36 @@ +(* + * nm_ip4_config.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_IP4Config + +let addresses proxy = + OBus_property.map_r + (fun x -> List.map (List.map Int32.to_int) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy) + +let nameservers proxy = + OBus_property.map_r + (fun x -> List.map Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy) + +let wins_servers proxy = + OBus_property.map_r + (fun x -> List.map Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_WinsServers proxy) + +let domains proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy + +let routes proxy = + OBus_property.map_r + (fun x -> List.map (List.map Int32.to_int) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy) + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface diff --git a/bindings/network-manager/nm_ip4_config.mli b/bindings/network-manager/nm_ip4_config.mli new file mode 100644 index 0000000..26bbd6d --- /dev/null +++ b/bindings/network-manager/nm_ip4_config.mli @@ -0,0 +1,20 @@ +(* + * nm_ip4_config.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Ip4 configuration *) + +include OBus_proxy.Private + +val addresses : t -> int list list OBus_property.r +val nameservers : t -> int list OBus_property.r +val wins_servers : t -> int list OBus_property.r +val domains : t -> string list OBus_property.r +val routes : t -> int list list OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_ip6_config.ml b/bindings/network-manager/nm_ip6_config.ml new file mode 100644 index 0000000..d2ccf11 --- /dev/null +++ b/bindings/network-manager/nm_ip6_config.ml @@ -0,0 +1,29 @@ +(* + * nm_ip6_config.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_IP6Config + +let addresses proxy = + OBus_property.map_r + (fun x -> List.map (fun (x1, x2) -> (x1, Int32.to_int x2)) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Addresses proxy) + +let nameservers proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Nameservers proxy + +let domains proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Domains proxy + +let routes proxy = + OBus_property.map_r + (fun x -> List.map (fun (x1, x2, x3, x4) -> (x1, Int32.to_int x2, x3, Int32.to_int x4)) x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_Routes proxy) + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface diff --git a/bindings/network-manager/nm_ip6_config.mli b/bindings/network-manager/nm_ip6_config.mli new file mode 100644 index 0000000..2238880 --- /dev/null +++ b/bindings/network-manager/nm_ip6_config.mli @@ -0,0 +1,19 @@ +(* + * nm_ip6_config.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Ip6 configuration *) + +include OBus_proxy.Private + +val addresses : t -> (string * int) list OBus_property.r +val nameservers : t -> string list OBus_property.r +val domains : t -> string list OBus_property.r +val routes : t -> (string * int * string * int) list OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_manager.ml b/bindings/network-manager/nm_manager.ml new file mode 100644 index 0000000..134ef9d --- /dev/null +++ b/bindings/network-manager/nm_manager.ml @@ -0,0 +1,128 @@ +(* + * nm_manager.ml + * ------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +let section = Lwt_log.Section.make "network-manager" + +include OBus_peer.Private + +let daemon () = + let%lwt bus = OBus_bus.system () in + Lwt.return (OBus_peer.make bus "org.freedesktop.NetworkManager") + +(* +-----------------------------------------------------------------+ + | Types | + +-----------------------------------------------------------------+ *) + +type state = + [ `Unknown + | `Asleep + | `Connecting + | `Connected + | `Disconnected ] + +let state_of_int32 = function + | 0l -> `Unknown + | 1l -> `Asleep + | 2l -> `Connecting + | 3l -> `Connected + | 4l -> `Disconnected + | i -> ignore (Lwt_log.warning_f ~section "Nm_manager.state_of_int32: unknown state: %ld" i); `Unknown + +(* +-----------------------------------------------------------------+ + | D-Bus definitions | + +-----------------------------------------------------------------+ *) + +let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "NetworkManager"] + +open Nm_interfaces.Org_freedesktop_NetworkManager + +let get_devices daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_GetDevices (proxy daemon) () in + return ( + List.map + (fun path -> + Nm_device.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + devices + ) + +let activate_connection daemon ~service_name ~connection ~device ~specific_object = + let connection = OBus_proxy.path (Nm_settings.Connection.to_proxy connection) in + let device = OBus_proxy.path (Nm_device.to_proxy device) in + let specific_object = OBus_proxy.path specific_object in + let%lwt (context, active_connection) = + OBus_method.call_with_context + m_ActivateConnection + (proxy daemon) + (service_name, connection, device, specific_object) + in + return ( + Nm_connection.of_proxy + (OBus_proxy.make (OBus_context.sender context) active_connection) + ) + +let deactivate_connection daemon ~active_connection = + let active_connection = OBus_proxy.path (Nm_connection.to_proxy active_connection) in + OBus_method.call m_DeactivateConnection (proxy daemon) active_connection + +let sleep daemon ~sleep = + OBus_method.call m_Sleep (proxy daemon) sleep + +let wireless_enabled daemon = + OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessEnabled (proxy daemon) + +let wireless_hardware_enabled daemon = + OBus_property.make ~monitor:Nm_monitor.monitor p_WirelessHardwareEnabled (proxy daemon) + +let wwan_enabled daemon = + OBus_property.make ~monitor:Nm_monitor.monitor p_WwanEnabled (proxy daemon) + +let wwan_hardware_enabled daemon = + OBus_property.make ~monitor:Nm_monitor.monitor p_WwanHardwareEnabled (proxy daemon) + +let active_connections daemon = + OBus_property.map_r_with_context + (fun context paths -> + List.map + (fun path -> + Nm_connection.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + paths) + (OBus_property.make ~monitor:Nm_monitor.monitor p_ActiveConnections (proxy daemon)) + +let state daemon = + OBus_property.map_r + state_of_int32 + (OBus_property.make ~monitor:Nm_monitor.monitor p_State (proxy daemon)) + +let state_changed daemon = + OBus_signal.map + state_of_int32 + (OBus_signal.make s_StateChanged (proxy daemon)) + +let properties_changed daemon = + OBus_signal.make s_PropertiesChanged (proxy daemon) + +let device_added daemon = + OBus_signal.map_with_context + (fun context state -> + Nm_device.of_proxy (OBus_proxy.make (OBus_context.sender context) state)) + (OBus_signal.make s_DeviceAdded (proxy daemon)) + +let device_removed daemon = + OBus_signal.map_with_context + (fun context state -> + Nm_device.of_proxy (OBus_proxy.make (OBus_context.sender context) state)) + (OBus_signal.make s_DeviceRemoved (proxy daemon)) + +let properties daemon = + OBus_property.group ~monitor:Nm_monitor.monitor (proxy daemon) interface diff --git a/bindings/network-manager/nm_manager.mli b/bindings/network-manager/nm_manager.mli new file mode 100644 index 0000000..1c72201 --- /dev/null +++ b/bindings/network-manager/nm_manager.mli @@ -0,0 +1,62 @@ +(* + * nm_manager.mli + * -------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** NetworkManager main interface *) + +include OBus_peer.Private + +val daemon : unit -> t Lwt.t + (** [daemon ()] returns the peer object for the network manager daemon *) + +(** {6 Types} *) + +(** State of the daemon *) +type state = + [ `Unknown + (** The NetworkManager daemon is in an unknown state. *) + | `Asleep + (** The NetworkManager daemon is asleep and all interfaces + managed by it are inactive. *) + | `Connecting + (** The NetworkManager daemon is connecting a device. *) + | `Connected + (** The NetworkManager daemon is connected. *) + | `Disconnected + (** The NetworkManager daemon is disconnected. *) ] + +(** {6 Methods} *) + +val get_devices : t -> Nm_device.t list Lwt.t +val activate_connection : t -> + service_name : OBus_name.bus -> + connection : Nm_settings.Connection.t -> + device : Nm_device.t -> + specific_object : OBus_proxy.t -> + Nm_connection.t Lwt.t +val deactivate_connection : t -> active_connection : Nm_connection.t -> unit Lwt.t +val sleep : t -> sleep : bool -> unit Lwt.t + +(** {6 Signals} *) + +val state_changed : t -> state OBus_signal.t +val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t +val device_added : t -> Nm_device.t OBus_signal.t +val device_removed : t -> Nm_device.t OBus_signal.t + +(** {6 Properties} *) + +val wireless_enabled : t -> bool OBus_property.rw +val wireless_hardware_enabled : t -> bool OBus_property.r +val wwan_enabled : t -> bool OBus_property.rw +val wwan_hardware_enabled : t -> bool OBus_property.r +val active_connections : t -> Nm_connection.t list OBus_property.r +val state : t -> state OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_monitor.ml b/bindings/network-manager/nm_monitor.ml new file mode 100644 index 0000000..11e34f0 --- /dev/null +++ b/bindings/network-manager/nm_monitor.ml @@ -0,0 +1,33 @@ +(* + * nm_monitor.ml + * ------------- + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt_react +open Lwt +open OBus_value + +module String_map = Map.Make(String) + +let properties_changed interface = + OBus_member.Signal.make + ~interface + ~member:"PropertiesChanged" + ~args:(arg1 (Some "properties", C.dict C.string C.variant)) + ~annotations:[] + +let monitor proxy interface switch = + let%lwt event = + OBus_signal.connect ~switch + (OBus_signal.with_context + (OBus_signal.make (properties_changed interface) proxy)) + and context, dict = OBus_property.get_all_no_cache proxy interface in + return (S.fold_s ~eq:(String_map.equal (=)) + (fun map (context, updates) -> + return (OBus_property.update_map context updates map)) + (OBus_property.map_of_list context dict) + event) diff --git a/bindings/network-manager/nm_monitor.mli b/bindings/network-manager/nm_monitor.mli new file mode 100644 index 0000000..4fef481 --- /dev/null +++ b/bindings/network-manager/nm_monitor.mli @@ -0,0 +1,13 @@ +(* + * nm_monitor.mli + * -------------- + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Properties monitoring *) + +val monitor : OBus_property.monitor + (** Monitor for properties of Network Manager interfaces. *) diff --git a/bindings/network-manager/nm_ppp.ml b/bindings/network-manager/nm_ppp.ml new file mode 100644 index 0000000..45b3c8a --- /dev/null +++ b/bindings/network-manager/nm_ppp.ml @@ -0,0 +1,20 @@ +(* + * nm_ppp.ml + * --------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_PPP + +let need_secrets proxy = + OBus_method.call m_NeedSecrets proxy () + +let set_ip4_config proxy ~config = + OBus_method.call m_SetIp4Config proxy config + +let set_state proxy ~state = + let state = Int32.of_int state in + OBus_method.call m_SetState proxy state diff --git a/bindings/network-manager/nm_ppp.mli b/bindings/network-manager/nm_ppp.mli new file mode 100644 index 0000000..90ada8c --- /dev/null +++ b/bindings/network-manager/nm_ppp.mli @@ -0,0 +1,16 @@ +(* + * nm_ppp.mli + * ---------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** PPP *) + +include OBus_proxy.Private + +val need_secrets : t -> (string * string) Lwt.t +val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t +val set_state : t -> state : int -> unit Lwt.t diff --git a/bindings/network-manager/nm_settings.ml b/bindings/network-manager/nm_settings.ml new file mode 100644 index 0000000..24a1a4c --- /dev/null +++ b/bindings/network-manager/nm_settings.ml @@ -0,0 +1,98 @@ +(* + * nm_settings.ml + * -------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +open Lwt + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManagerSettings + +let user () = + let%lwt bus = OBus_bus.session () in + return (OBus_proxy.make + (OBus_peer.make bus "org.freedesktop.NetworkManagerUserSettings") + [ "org"; "freedesktop"; "NetworkManagerSettings" ]) + +let system () = + let%lwt bus = OBus_bus.system () in + return (OBus_proxy.make + (OBus_peer.make bus "org.freedesktop.NetworkManagerSystemSettings") + [ "org"; "freedesktop"; "NetworkManagerSettings" ]) + +module Connection = +struct + include OBus_proxy.Private + + open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection + + let update proxy ~properties = + OBus_method.call m_Update proxy properties + + let delete proxy = + OBus_method.call m_Delete proxy () + + let get_settings proxy = + OBus_method.call m_GetSettings proxy () + + let updated proxy = + OBus_signal.make s_Updated proxy + + let removed proxy = + OBus_signal.make s_Removed proxy + + module Secrets = + struct + open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_Connection_Secrets + + let get_secrets proxy ~setting_name ~hints ~request_new = + OBus_method.call m_GetSecrets proxy (setting_name, hints, request_new) + end +end + +module System = +struct + open Nm_interfaces.Org_freedesktop_NetworkManagerSettings_System + + let save_hostname proxy ~hostname = + OBus_method.call m_SaveHostname proxy hostname + + let hostname proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Hostname proxy + + let can_modify proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_CanModify proxy + + let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + + let check_permissions proxy = + OBus_signal.make s_CheckPermissions proxy + + let get_permissions proxy = + let%lwt permissions = OBus_method.call m_GetPermissions proxy () in + let permissions = Int32.to_int permissions in + return permissions +end + +let list_connections proxy = + let%lwt (context, connections) = OBus_method.call_with_context m_ListConnections proxy () in + return ( + List.map + (fun path -> + Connection.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + connections + ) + +let add_connection proxy ~connection = + OBus_method.call m_AddConnection proxy connection + +let new_connection proxy = + OBus_signal.map_with_context + (fun context connection -> + Connection.of_proxy (OBus_proxy.make (OBus_context.sender context) connection)) + (OBus_signal.make s_NewConnection proxy) diff --git a/bindings/network-manager/nm_settings.mli b/bindings/network-manager/nm_settings.mli new file mode 100644 index 0000000..acd3409 --- /dev/null +++ b/bindings/network-manager/nm_settings.mli @@ -0,0 +1,60 @@ +(* + * nm_settings.mli + * --------------- + * Copyright : (c) 2010, Pierre Chambart <chambart@crans.org> + * 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** NetworkManager settings *) + +include OBus_proxy.Private + +val user : unit -> t Lwt.t + (** [user ()] returns the proxy object for user settings. The object + is on the session message bus. *) + +val system : unit -> t Lwt.t + (** [system ()] returns the proxy object for system settings. The + object is on the system message bus *) + +(** Connection settings *) +module Connection : sig + include OBus_proxy.Private + + (** {6 Methods} *) + + val update : t -> properties : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t + val delete : t -> unit Lwt.t + val get_settings : t -> (string * (string * OBus_value.V.single) list) list Lwt.t + + (** {6 Signals} *) + + val updated : t -> (string * (string * OBus_value.V.single) list) list OBus_signal.t + val removed : t -> unit OBus_signal.t + + module Secrets : sig + val get_secrets : t -> setting_name : string -> hints : string list -> request_new : bool -> (string * (string * OBus_value.V.single) list) list Lwt.t + end +end + +(** System settings *) +module System : sig + val save_hostname : t -> hostname : string -> unit Lwt.t + val hostname : t -> string OBus_property.r + val can_modify : t -> bool OBus_property.r + val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + val check_permissions : t -> unit OBus_signal.t + val get_permissions : t -> int Lwt.t +end + +(** {6 Methods} *) + +val list_connections : t -> Connection.t list Lwt.t + +(** {6 Signals} *) + +val add_connection : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t +val new_connection : t -> Connection.t OBus_signal.t diff --git a/bindings/network-manager/nm_vpn_connection.ml b/bindings/network-manager/nm_vpn_connection.ml new file mode 100644 index 0000000..aa41cd7 --- /dev/null +++ b/bindings/network-manager/nm_vpn_connection.ml @@ -0,0 +1,32 @@ +(* + * nm_vpn_connection.ml + * -------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Connection + +let properties_changed proxy = + OBus_signal.make s_PropertiesChanged proxy + +let vpn_state proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_VpnState proxy) + +let banner proxy = + OBus_property.make ~monitor:Nm_monitor.monitor p_Banner proxy + +let vpn_state_changed proxy = + OBus_signal.map + (fun (state, reason) -> + let state = Int32.to_int state in + let reason = Int32.to_int reason in + (state, reason)) + (OBus_signal.make s_VpnStateChanged proxy) + +let properties proxy = + OBus_property.group ~monitor:Nm_monitor.monitor proxy interface diff --git a/bindings/network-manager/nm_vpn_connection.mli b/bindings/network-manager/nm_vpn_connection.mli new file mode 100644 index 0000000..0104606 --- /dev/null +++ b/bindings/network-manager/nm_vpn_connection.mli @@ -0,0 +1,20 @@ +(* + * nm_vpn_connection.mli + * --------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** VPN connections *) + +include OBus_proxy.Private + +val vpn_state_changed : t -> (int * int) OBus_signal.t +val properties_changed : t -> (string * OBus_value.V.single) list OBus_signal.t + +val vpn_state : t -> int OBus_property.r +val banner : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/network-manager/nm_vpn_plugin.ml b/bindings/network-manager/nm_vpn_plugin.ml new file mode 100644 index 0000000..8738593 --- /dev/null +++ b/bindings/network-manager/nm_vpn_plugin.ml @@ -0,0 +1,50 @@ +(* + * nm_vpn_plugin.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + *) + +include OBus_proxy.Private + +open Nm_interfaces.Org_freedesktop_NetworkManager_VPN_Plugin + +let connect proxy ~connection = + OBus_method.call m_Connect proxy connection + +let need_secrets proxy ~settings = + OBus_method.call m_NeedSecrets proxy settings + +let disconnect proxy = + OBus_method.call m_Disconnect proxy () + +let set_ip4_config proxy ~config = + OBus_method.call m_SetIp4Config proxy config + +let set_failure proxy ~reason = + OBus_method.call m_SetFailure proxy reason + +let state proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:Nm_monitor.monitor p_State proxy) + +let state_changed proxy = + OBus_signal.map + (fun state -> + let state = Int32.to_int state in + state) + (OBus_signal.make s_StateChanged proxy) + +let ip4_config proxy = + OBus_signal.make s_Ip4Config proxy + +let login_banner proxy = + OBus_signal.make s_LoginBanner proxy + +let failure proxy = + OBus_signal.map + (fun reason -> + let reason = Int32.to_int reason in + reason) + (OBus_signal.make s_Failure proxy) diff --git a/bindings/network-manager/nm_vpn_plugin.mli b/bindings/network-manager/nm_vpn_plugin.mli new file mode 100644 index 0000000..8dee401 --- /dev/null +++ b/bindings/network-manager/nm_vpn_plugin.mli @@ -0,0 +1,25 @@ +(* + * nm_vpn_plugin.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** VPN plugin interface *) + +include OBus_proxy.Private + +val connect : t -> connection : (string * (string * OBus_value.V.single) list) list -> unit Lwt.t +val need_secrets : t -> settings : (string * (string * OBus_value.V.single) list) list -> string Lwt.t +val disconnect : t -> unit Lwt.t +val set_ip4_config : t -> config : (string * OBus_value.V.single) list -> unit Lwt.t +val set_failure : t -> reason : string -> unit Lwt.t + +val state_changed : t -> int OBus_signal.t +val ip4_config : t -> (string * OBus_value.V.single) list OBus_signal.t +val login_banner : t -> string OBus_signal.t +val failure : t -> int OBus_signal.t + +val state : t -> int OBus_property.r diff --git a/bindings/notification/dune b/bindings/notification/dune new file mode 100644 index 0000000..b6cf801 --- /dev/null +++ b/bindings/notification/dune @@ -0,0 +1,12 @@ +(library + (name obus_notification) + (public_name obus.notification) + (wrapped false) + (libraries lwt obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets notification_interfaces.ml notification_interfaces.mli) + (deps notification_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o notification_interfaces %{deps}))) diff --git a/bindings/notification/notification.ml b/bindings/notification/notification.ml new file mode 100644 index 0000000..714cfa9 --- /dev/null +++ b/bindings/notification/notification.ml @@ -0,0 +1,345 @@ +(* + * notification.ml + * --------------- + * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt_react +open Lwt +open OBus_value + +let app_name = ref (Filename.basename Sys.argv.(0)) +let desktop_entry = ref None + +(* +-----------------------------------------------------------------+ + | Types | + +-----------------------------------------------------------------+ *) + +type server_info = { + server_name : string; + server_vendor : string; + server_version : string; + server_spec_version : string; +} + +type image = { + img_width : int; + img_height : int; + img_rowstride : int; + img_has_alpha : bool; + img_bits_per_sample : int; + img_channels : int; + img_data : string; +} + +type urgency = [ `Low | `Normal | `Critical ] + +type id = int32 + (* An notification id *) + +(* All informations about an opened notification *) +type notification = { + mutable notif_deleted : bool; + (* Wether the notification as already been closed *) + + notif_action : string -> unit; + (* Wakeup the waiting thread when an action is received *) + + notif_closed : unit -> unit; + (* Wakeup the waiting thread with [`Closed] when a notification is + closed *) +} + +type 'a t = { + result : 'a Lwt.t; + notification : notification; + peer : OBus_peer.t; + id : id; +} + +module Peer_map = Map.Make(OBus_peer) +module Id_map = Map.Make(Int32) + +let notifications : notification Id_map.t ref Peer_map.t ref = ref Peer_map.empty + (* All opened notifications, by peer then id *) + +let default_action = "default" + (* Default action for notifications *) + +(* +-----------------------------------------------------------------+ + | D-Bus methods and signals | + +-----------------------------------------------------------------+ *) + +let server_name = "org.freedesktop.Notifications" +let server_path = ["org"; "freedesktop"; "Notifications"] + +open Notification_interfaces.Org_freedesktop_Notifications + +let proxy = lazy( + let%lwt bus = OBus_bus.session () in + return (OBus_proxy.make (OBus_peer.make bus server_name) server_path) +) + +let get_server_information () = + let%lwt proxy = Lazy.force proxy in + let%lwt name, vendor, version, spec_version = OBus_method.call m_GetServerInformation proxy () in + return { + server_name = name; + server_vendor = vendor; + server_version = version; + server_spec_version = spec_version; + } + +let get_capabilities () = + let%lwt proxy = Lazy.force proxy in + OBus_method.call m_GetCapabilities proxy () + +let notify proxy ~app_name ~id ~icon ~summary ~body ~actions ~hints ~timeout = + let%lwt context, return_id = OBus_method.call_with_context m_Notify proxy (app_name, id, icon, summary, body, actions, hints, Int32.of_int timeout) in + return (OBus_context.sender context, return_id) + +let close_notification proxy id = + OBus_method.call m_CloseNotification proxy id + +let s_NotificationClosed = + OBus_member.Signal.make + ~interface:"org.freedesktop.Notifications" + ~member:"NotificationClosed" + ~args:(arg2 + (None, C.basic_uint32) + (None, C.basic_uint32)) + ~annotations:[] + +let notification_closed proxy = + OBus_signal.make s_NotificationClosed proxy + +let s_ActionInvoked = + OBus_member.Signal.make + ~interface:"org.freedesktop.Notifications" + ~member:"ActionInvoked" + ~args:(arg2 + (None, C.basic_uint32) + (None, C.basic_string)) + ~annotations:[] + +let action_invoked proxy = + OBus_signal.make s_ActionInvoked proxy + +(* +-----------------------------------------------------------------+ + | Notifications monitoring | + +-----------------------------------------------------------------+ *) + +let monitor_peer peer = + ignore begin + let%lwt () = OBus_peer.wait_for_exit peer in + let m = Peer_map.find peer !notifications in + notifications := Peer_map.remove peer !notifications; + (* Cancel all opened notification opened on this peer: *) + Id_map.iter (fun id notif -> notif.notif_closed ()) !m; + return () + end + +let remove_notification peer id notif = + notif.notif_deleted <- true; + let r = Peer_map.find peer !notifications in + r := Id_map.remove id !r + +let init_callbacks = lazy( + let%lwt bus = OBus_bus.session () in + + (* Create an anymous proxy for connecting signals, so we will + receive signals comming from any daemon *) + let anonymous_proxy = { OBus_proxy.peer = OBus_peer.anonymous bus; + OBus_proxy.path = server_path } in + + let%lwt event = + OBus_signal.connect + (OBus_signal.map_with_context + (fun context (id, reason) -> (OBus_context.sender context, id, reason)) + (notification_closed anonymous_proxy)) + in + + (* Handle signals for closed notifications *) + E.keep + (E.map_p + (fun (peer, id, reason) -> + match try Some(Peer_map.find peer !notifications) with Not_found -> None with + | None -> + return () + | Some m -> + match try Some(Id_map.find id !m) with Not_found -> None with + | None -> + return () + | Some notif -> + remove_notification peer id notif; + notif.notif_closed (); + return ()) + event); + + let%lwt event = + OBus_signal.connect + (OBus_signal.map_with_context + (fun context (id, action) -> (OBus_context.sender context, id, action)) + (action_invoked anonymous_proxy)) + in + + (* Handle signals for actions *) + E.keep + (E.map_p + (fun (peer, id, action) -> + match try Some(Peer_map.find peer !notifications) with Not_found -> None with + | None -> + return () + | Some m -> + match try Some(Id_map.find id !m) with Not_found -> None with + | None -> + return () + | Some notif -> + remove_notification peer id notif; + notif.notif_action action; + return ()) + event); + + return () +) + +(* +-----------------------------------------------------------------+ + | Operations on notifications | + +-----------------------------------------------------------------+ *) + +let result n = n.result + +let close n = + let notif = n.notification in + if not notif.notif_deleted then begin + remove_notification n.peer n.id notif; + notif.notif_closed (); + (* Call the method on the peer which have opened the + notification *) + close_notification (OBus_proxy.make n.peer server_path) n.id + end else + return () + +(* +-----------------------------------------------------------------+ + | Openning notifications | + +-----------------------------------------------------------------+ *) + +let rec filter_opt = function + | [] -> [] + | Some x :: l -> + x :: filter_opt l + | None :: l -> + filter_opt l + +let default_desktop_entry = desktop_entry + +let notify ?(app_name= !app_name) ?desktop_entry + ?replace ?(icon="") ?image ~summary ?(body="") ?(actions=[]) + ?urgency ?category ?sound_file ?suppress_sound ?pos ?(hints=[]) ?(timeout= -1) () = + + let desktop_entry = + match desktop_entry with + | None -> !default_desktop_entry + | x -> x + in + + (*** Creation of hints ***) + let make_hint name x f = + match x with + | Some x -> Some(name, f x) + | None -> None + in + let hints = + filter_opt + [make_hint "desktop-entry" desktop_entry V.basic_string; + make_hint "image_data" image + (fun image -> + V.structure + [V.basic_int32 (Int32.of_int image.img_width); + V.basic_int32 (Int32.of_int image.img_height); + V.basic_int32 (Int32.of_int image.img_rowstride); + V.basic_boolean image.img_has_alpha; + V.basic_int32 (Int32.of_int image.img_bits_per_sample); + V.basic_int32 (Int32.of_int image.img_channels); + V.byte_array image.img_data]); + make_hint "urgency" urgency + (fun urgency -> + V.basic_int32 (match urgency with + | `Low -> 0l + | `Normal -> 1l + | `Critical -> 2l)); + make_hint "category" category V.basic_string; + make_hint "sound-file" sound_file V.basic_string; + make_hint "suppress-sound" suppress_sound V.basic_boolean; + make_hint "x" pos (fun (x, y) -> V.basic_int32(Int32.of_int x)); + make_hint "y" pos (fun (x, y) -> V.basic_int32(Int32.of_int y))] + @ hints in + + (*** Handling of actions ***) + let _, actions, actions_map = + List.fold_right + (fun (text, user_key) (acc, al, am) -> + (* For each action, generate a key and associate it to the + given function *) + let key = Printf.sprintf "key%d" acc in + (acc + 1, key :: text :: al, (key, user_key) :: am)) + actions (0, [], []) in + let actions_map = (default_action, `Default) :: actions_map in + + (* Setup callbacks *) + let%lwt () = Lazy.force init_callbacks in + + (* Get the proxy *) + let%lwt daemon = Lazy.force proxy in + + (* Create the notification *) + let%lwt peer, id = + notify + daemon + ~app_name + ~id:(match replace with + | Some n -> n.id + | None -> 0l) + ~icon + ~summary + ~body + ~actions + ~hints + ~timeout + in + + let waiter, wakener = wait () in + let notif = { + notif_deleted = false; + notif_action = (fun action -> + wakeup wakener (try + List.assoc action actions_map + with Not_found -> + `Default)); + notif_closed = (fun () -> wakeup wakener `Closed); + } in + + begin + try + let r = Peer_map.find peer !notifications in + r := Id_map.add id notif !r + with Not_found -> + notifications := + Peer_map.add + peer + (ref (Id_map.add id notif Id_map.empty)) + !notifications; + (* Monitor the peer to be sure the notification is closed when + the peer exits *) + monitor_peer peer + end; + + return { + result = waiter; + notification = notif; + peer = peer; + id = id; + } diff --git a/bindings/notification/notification.mli b/bindings/notification/notification.mli new file mode 100644 index 0000000..0d59a35 --- /dev/null +++ b/bindings/notification/notification.mli @@ -0,0 +1,117 @@ +(* + * notification.mli + * ---------------- + * Copyright : (c) 2008, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Popup notifications *) + +(** For complete details about notifications, look at the + {{:http://www.galago-project.org/specs/notification/} the official + specifications} *) + +val app_name : string ref + (** Application name used for notification. The default value is + taken from [Sys.argv.(0)] *) + +val desktop_entry : string option ref + (** If the application has a desktop entry, it can be specified + here *) + +(** {6 Operations on notifications} *) + +(** Type of an opened notifications *) +type 'a t + +val result : 'a t -> 'a Lwt.t + (** Waits for a notification to be closed then returns: + + - [`Closed] if the user clicked on the cross, timeout was + reached or the notification daemon exited + + - [`Default] if the default action was invoked, i.e. the user + clicked on the notification, but not on a buttons + + - the corresponding action if the user clicked on a button other + than the cross *) + +val close : 'a t -> unit Lwt.t + (** Close the notification now *) + +(** {6 Opening notifications} *) + +type urgency = [ `Low | `Normal | `Critical ] + (** Urgency level of popups *) + +(** An image description *) +type image = { + img_width : int; + img_height : int; + img_rowstride : int; + img_has_alpha: bool; + img_bits_per_sample : int; + img_channels : int; + img_data : string; +} + +val notify : + ?app_name : string -> + ?desktop_entry : string -> + ?replace : _ t -> + ?icon : string -> + ?image : image -> + summary : string -> + ?body : string -> + ?actions : (string * ([> `Default | `Closed ] as 'a)) list -> + ?urgency : urgency -> + ?category : string -> + ?sound_file : string -> + ?suppress_sound : bool -> + ?pos : int * int -> + ?hints : (string * OBus_value.V.single) list -> + ?timeout : int -> + unit -> 'a t Lwt.t + (** Open a notification. + + - [app_name] and [desktop_entry] can override default values + taken from references + - [replace] is a popup id this notification replace + - [icon] is the notification icon. It is either as a URI (file://...) or a + name in a freedesktop.org-compliant icon theme (not a GTK+ stock ID) + - [image] is an image, it is used if [icon] is not present + - [summary] is a single line overview of the notification + - [body] is a multi-line body of text. Each line is a paragraph, + server implementations are free to word wrap them as they see fit. + The body may contain simple markup as specified in Markup. It must be + encoded using UTF-8. If the body is omitted, just the summary is + displayed. + - [action] is a list of (text, key) pair, [text] is the text displayed to the user + and [key] is the value which will be returned when the action is invoked + - [category] is a string representing the category of the + notification, for example: "device.added", "email.arrived" + (more category can be found in the specifications) + - [sound_file] is a sound file to play while displaying the notification + - [suppress_sound] tell the daemon to suppress sounds + - [pos] is a screen position + - [hints] is a list of additionnal hints + - [timeout] is a timeout in millisecond + *) + +(** {6 Informations} *) + +(** Server informations *) +type server_info = { + server_name : string; + server_vendor : string; + server_version : string; + server_spec_version : string; +} + +val get_server_information : unit -> server_info Lwt.t + (** Retreive server informations *) + +val get_capabilities : unit -> string list Lwt.t + (** Retreive server capabilities, see specification for details *) diff --git a/bindings/notification/notification_interfaces.obus b/bindings/notification/notification_interfaces.obus new file mode 100644 index 0000000..523ac0c --- /dev/null +++ b/bindings/notification/notification_interfaces.obus @@ -0,0 +1,15 @@ +(* + * notification_interfaces.obus + * ---------------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.Notifications { + method GetServerInformation : () -> (return_name : string, return_vendor : string, return_version : string, return_spec_version : string) + method GetCapabilities : () -> (return_caps : string array) + method CloseNotification : (id : uint32) -> () + method Notify : (app_name : string, id : uint32, icon : string, summary : string, body : string, actions : string array, hints : (string, variant) dict, timeout : int32) -> (return_id : uint32) +} diff --git a/bindings/policykit/dune b/bindings/policykit/dune new file mode 100644 index 0000000..81be6ca --- /dev/null +++ b/bindings/policykit/dune @@ -0,0 +1,12 @@ +(library + (name obus_policy_kit) + (public_name obus.policykit) + (wrapped false) + (libraries lwt obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets policy_kit_interfaces.ml policy_kit_interfaces.mli) + (deps policy_kit_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o policy_kit_interfaces %{deps}))) diff --git a/bindings/policykit/policy_kit.ml b/bindings/policykit/policy_kit.ml new file mode 100644 index 0000000..2e038c5 --- /dev/null +++ b/bindings/policykit/policy_kit.ml @@ -0,0 +1,21 @@ +(* + * policy_kit.ml + * ------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +let not_authorized = "org.freedesktop.PolicyKit.Error.NotAuthorized" + +open Policy_kit_interfaces.Org_freedesktop_PolicyKit_AuthenticationAgent + +let obtain_authorization ~action_id ?(xid=0) ~pid () = + let%lwt session_bus = OBus_bus.session () in + let proxy = + OBus_proxy.make + (OBus_peer.make session_bus "org.freedesktop.PolicyKit.AuthenticationAgent") + [] + in + OBus_method.call m_ObtainAuthorization proxy (action_id, Int32.of_int xid, Int32.of_int pid) diff --git a/bindings/policykit/policy_kit.mli b/bindings/policykit/policy_kit.mli new file mode 100644 index 0000000..8317fb1 --- /dev/null +++ b/bindings/policykit/policy_kit.mli @@ -0,0 +1,24 @@ +(* + * policy_kit.mli + * -------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** PolicyKit interface *) + +val not_authorized : OBus_error.name + (** Exception raised by services when trying to perform an action + for which we do not have authorization from PolicyKit *) + +val obtain_authorization : action_id : string -> ?xid : int -> pid : int -> unit -> bool Lwt.t + (** [obtain_authorization ~action_id ~xid ~pid] tries to obtain + authorization for [action_id]. It returns whether it succeed or not. + + @param action_id PolicyKit action identifier; see PolKitAction + @param xid X11 window ID for the top-level X11 window the dialog + will be transient for + @param pid Process ID to grant authorization to + *) diff --git a/bindings/policykit/policy_kit_interfaces.obus b/bindings/policykit/policy_kit_interfaces.obus new file mode 100644 index 0000000..ce3b12b --- /dev/null +++ b/bindings/policykit/policy_kit_interfaces.obus @@ -0,0 +1,12 @@ +(* + * policy_kit_interfaces.obus + * -------------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.PolicyKit.AuthenticationAgent { + method ObtainAuthorization : (action_id : string, xid : uint32, pid : uint32) -> (gained_authorization : boolean) +} diff --git a/bindings/udisks/dune b/bindings/udisks/dune new file mode 100644 index 0000000..4454725 --- /dev/null +++ b/bindings/udisks/dune @@ -0,0 +1,12 @@ +(library + (name obus_udisks) + (public_name obus.udisks) + (wrapped false) + (libraries lwt obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets uDisks_interfaces.ml uDisks_interfaces.mli) + (deps uDisks_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o uDisks_interfaces %{deps}))) diff --git a/bindings/udisks/uDisks.ml b/bindings/udisks/uDisks.ml new file mode 100644 index 0000000..7a4f986 --- /dev/null +++ b/bindings/udisks/uDisks.ml @@ -0,0 +1,298 @@ +(* + * uDisks.ml + * --------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +(* +-----------------------------------------------------------------+ + | Types | + +-----------------------------------------------------------------+ *) + +type inhibit_cookie = string +type all_spindown_timeouts_cookie = string +type inhibit_all_polling_cookie = string + +type fs = { + fs_id : string; + fs_name : string; + fs_supports_unix_owners : bool; + fs_can_mount : bool; + fs_can_create : bool; + fs_max_label_len : int; + fs_supports_label_rename : bool; + fs_supports_online_label_rename : bool; + fs_supports_fsck : bool; + fs_supports_online_fsck : bool; + fs_supports_resize_enlarge : bool; + fs_supports_online_resize_enlarge : bool; + fs_supports_resize_shrink : bool; + fs_supports_online_resize_shrink : bool; +} + +type job = { + job_device : UDisks_device.t; + job_in_progress : bool; + job_is_cancellable : bool; + job_id : string; + job_num_tasks : int; + job_cur_task : int; + job_cur_task_id : string; + job_cur_task_percentage : float; +} + +(* +-----------------------------------------------------------------+ + | Exceptions | + +-----------------------------------------------------------------+ *) + +exception Busy +exception Cancelled +exception Failed +exception Filesystem_driver_missing +exception Filesystem_tools_missing +exception Inhibited +exception Invalid_option +exception Not_found +exception Not_supported +exception Permission_denied + +let busy = "org.freedesktop.UDisks.Error.Busy" +let cancelled = "org.freedesktop.UDisks.Error.Cancelled" +let failed = "org.freedesktop.UDisks.Error.Failed" +let filesystem_driver_missing = "org.freedesktop.UDisks.Error.FilesystemDriverMissing" +let filesystem_tools_missing = "org.freedesktop.UDisks.Error.FilesystemToolsMissing" +let inhibited = "org.freedesktop.UDisks.Error.Inhibited" +let invalid_option = "org.freedesktop.UDisks.Error.InvalidOption" +let not_found = "org.freedesktop.UDisks.Error.NotFound" +let not_supported = "org.freedesktop.UDisks.Error.NotSupported" +let permission_denied = "org.freedesktop.UDisks.Error.PermissionDenied" + +(* +-----------------------------------------------------------------+ + | D-Bus definitions | + +-----------------------------------------------------------------+ *) + +include OBus_peer.Private + +let daemon () = + let%lwt bus = OBus_bus.system () in + return (OBus_peer.make bus "org.freedesktop.UDisks") + +open UDisks_interfaces.Org_freedesktop_UDisks + +let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "UDisks"] + +let make_device context path = + UDisks_device.of_proxy (OBus_proxy.make (OBus_context.sender context) path) +let make_adapter context path = + UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) path) +let make_expander context path = + UDisks_expander.of_proxy (OBus_proxy.make (OBus_context.sender context) path) +let make_port context path = + UDisks_port.of_proxy (OBus_proxy.make (OBus_context.sender context) path) + +let enumerate_adapters daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateAdapters (proxy daemon) () in + return (List.map (make_adapter context) devices) + +let enumerate_expanders daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateExpanders (proxy daemon) () in + return (List.map (make_expander context) devices) + +let enumerate_ports daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_EnumeratePorts (proxy daemon) () in + return (List.map (make_port context) devices) + +let enumerate_devices daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateDevices (proxy daemon) () in + return (List.map (make_device context) devices) + +let enumerate_device_files daemon = + OBus_method.call m_EnumerateDeviceFiles (proxy daemon) () + +let find_device_by_device_file daemon ~device_file = + let%lwt (context, device) = OBus_method.call_with_context m_FindDeviceByDeviceFile (proxy daemon) device_file in + return (make_device context device) + +let find_device_by_major_minor daemon ~device_major ~device_minor = + let%lwt (context, device) = OBus_method.call_with_context m_FindDeviceByMajorMinor (proxy daemon) (device_major, device_minor) in + return (make_device context device) + +let drive_inhibit_all_polling daemon ~options = + OBus_method.call m_DriveInhibitAllPolling (proxy daemon) options + +let drive_uninhibit_all_polling daemon ~cookie = + OBus_method.call m_DriveUninhibitAllPolling (proxy daemon) cookie + +let drive_set_all_spindown_timeouts daemon ~timeout_seconds ~options = + let timeout_seconds = Int32.of_int timeout_seconds in + OBus_method.call m_DriveSetAllSpindownTimeouts (proxy daemon) (timeout_seconds, options) + +let drive_unset_all_spindown_timeouts daemon ~cookie = + OBus_method.call m_DriveUnsetAllSpindownTimeouts (proxy daemon) cookie + +let linux_lvm2_vgstart daemon ~uuid ~options = + OBus_method.call m_LinuxLvm2VGStart (proxy daemon) (uuid, options) + +let linux_lvm2_vgstop daemon ~uuid ~options = + OBus_method.call m_LinuxLvm2VGStop (proxy daemon) (uuid, options) + +let linux_lvm2_vgset_name daemon ~uuid ~name = + OBus_method.call m_LinuxLvm2VGSetName (proxy daemon) (uuid, name) + +let linux_lvm2_vgadd_pv daemon ~uuid ~physical_volume ~options = + let physical_volume = OBus_proxy.path (UDisks_device.to_proxy physical_volume) in + OBus_method.call m_LinuxLvm2VGAddPV (proxy daemon) (uuid, physical_volume, options) + +let linux_lvm2_vgremove_pv daemon ~vg_uuid ~pv_uuid ~options = + OBus_method.call m_LinuxLvm2VGRemovePV (proxy daemon) (vg_uuid, pv_uuid, options) + +let linux_lvm2_lvset_name daemon ~group_uuid ~uuid ~name = + OBus_method.call m_LinuxLvm2LVSetName (proxy daemon) (group_uuid, uuid, name) + +let linux_lvm2_lvstart daemon ~group_uuid ~uuid ~options = + OBus_method.call m_LinuxLvm2LVStart (proxy daemon) (group_uuid, uuid, options) + +let linux_lvm2_lvremove daemon ~group_uuid ~uuid ~options = + OBus_method.call m_LinuxLvm2LVRemove (proxy daemon) (group_uuid, uuid, options) + +let linux_lvm2_lvcreate daemon ~group_uuid ~name ~size ~num_stripes ~stripe_size ~num_mirrors ~options ~fstype ~fsoptions = + let num_stripes = Int32.of_int num_stripes in + let num_mirrors = Int32.of_int num_mirrors in + let%lwt (context, created_device) = OBus_method.call_with_context m_LinuxLvm2LVCreate (proxy daemon) (group_uuid, name, size, num_stripes, stripe_size, num_mirrors, options, fstype, fsoptions) in + return (make_device context created_device) + +let linux_md_start daemon ~components ~options = + let components = List.map (fun c -> OBus_proxy.path (UDisks_device.to_proxy c)) components in + let%lwt (context, device) = OBus_method.call_with_context m_LinuxMdStart (proxy daemon) (components, options) in + return (make_device context device) + +let linux_md_create daemon ~components ~level ~stripe_size ~name ~options = + let components = List.map (fun c -> OBus_proxy.path (UDisks_device.to_proxy c)) components in + let%lwt (context, device) = OBus_method.call_with_context m_LinuxMdCreate (proxy daemon) (components, level, stripe_size, name, options) in + return (make_device context device) + +let inhibit daemon = + OBus_method.call m_Inhibit (proxy daemon) () + +let uninhibit daemon ~cookie = + OBus_method.call m_Uninhibit (proxy daemon) cookie + +let device_added daemon = + OBus_signal.map_with_context + make_device + (OBus_signal.make s_DeviceAdded (proxy daemon)) + +let device_removed daemon = + OBus_signal.map_with_context + make_device + (OBus_signal.make s_DeviceRemoved (proxy daemon)) + +let device_changed daemon = + OBus_signal.map_with_context + make_device + (OBus_signal.make s_DeviceChanged (proxy daemon)) + +let device_job_changed daemon = + OBus_signal.map_with_context + (fun context (device, job_in_progress, job_is_cancellable, job_id, job_num_tasks, job_cur_task, job_cur_task_id, job_cur_task_percentage) -> { + job_device = make_device context device; + job_in_progress = job_in_progress; + job_is_cancellable = job_is_cancellable; + job_id = job_id; + job_num_tasks = Int32.to_int job_num_tasks; + job_cur_task = Int32.to_int job_cur_task; + job_cur_task_id = job_cur_task_id; + job_cur_task_percentage = job_cur_task_percentage; + }) + (OBus_signal.make s_DeviceJobChanged (proxy daemon)) + +let adapter_added daemon = + OBus_signal.map_with_context + make_adapter + (OBus_signal.make s_AdapterAdded (proxy daemon)) + +let adapter_removed daemon = + OBus_signal.map_with_context + make_adapter + (OBus_signal.make s_AdapterRemoved (proxy daemon)) + +let adapter_changed daemon = + OBus_signal.map_with_context + make_adapter + (OBus_signal.make s_AdapterChanged (proxy daemon)) + +let expander_added daemon = + OBus_signal.map_with_context + make_expander + (OBus_signal.make s_ExpanderAdded (proxy daemon)) + +let expander_removed daemon = + OBus_signal.map_with_context + make_expander + (OBus_signal.make s_ExpanderRemoved (proxy daemon)) + +let expander_changed daemon = + OBus_signal.map_with_context + make_expander + (OBus_signal.make s_ExpanderChanged (proxy daemon)) + +let port_added daemon = + OBus_signal.map_with_context + make_port + (OBus_signal.make s_PortAdded (proxy daemon)) + +let port_removed daemon = + OBus_signal.map_with_context + make_port + (OBus_signal.make s_PortRemoved (proxy daemon)) + +let port_changed daemon = + OBus_signal.map_with_context + make_port + (OBus_signal.make s_PortChanged (proxy daemon)) + +let daemon_version daemon = + OBus_property.make p_DaemonVersion (proxy daemon) + +let daemon_is_inhibited daemon = + OBus_property.make p_DaemonIsInhibited (proxy daemon) + +let supports_luks_devices daemon = + OBus_property.make p_SupportsLuksDevices (proxy daemon) + +let known_filesystems daemon = + OBus_property.map_r + (fun l -> + List.map + (fun (x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) -> { + fs_id = x1; + fs_name = x2; + fs_supports_unix_owners = x3; + fs_can_mount = x4; + fs_can_create = x5; + fs_max_label_len = Int32.to_int x6; + fs_supports_label_rename = x7; + fs_supports_online_label_rename = x8; + fs_supports_fsck = x9; + fs_supports_online_fsck = x10; + fs_supports_resize_enlarge = x11; + fs_supports_online_resize_enlarge = x12; + fs_supports_resize_shrink = x13; + fs_supports_online_resize_shrink = x14; + }) + l) + (OBus_property.make p_KnownFilesystems (proxy daemon)) + +type properties = { + known_filesystems : fs list; + supports_luks_devices : bool; + daemon_is_inhibited : bool; + daemon_version : string; +} + +let properties daemon = + OBus_property.group (proxy daemon) interface diff --git a/bindings/udisks/uDisks.mli b/bindings/udisks/uDisks.mli new file mode 100644 index 0000000..a08b1fd --- /dev/null +++ b/bindings/udisks/uDisks.mli @@ -0,0 +1,170 @@ +(* + * uDisks.mli + * ---------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UDisks main interface *) + +include OBus_peer.Private + +val daemon : unit -> t Lwt.t + (** [daemon ()] returns the peer object for the udisks daemon *) + +(** {6 Exceptions} *) + +val busy : OBus_error.name +val cancelled : OBus_error.name +val failed : OBus_error.name +val filesystem_driver_missing : OBus_error.name +val filesystem_tools_missing : OBus_error.name +val inhibited : OBus_error.name +val invalid_option : OBus_error.name +val not_found : OBus_error.name +val not_supported : OBus_error.name +val permission_denied : OBus_error.name + +(** {6 Methods} *) + +type inhibit_cookie + +val inhibit : t -> inhibit_cookie Lwt.t +val uninhibit : t -> cookie : inhibit_cookie -> unit Lwt.t + +val linux_md_create : t -> + components : UDisks_device.t list -> + level : string -> + stripe_size : int64 -> + name : string -> + options : string list -> + UDisks_device.t Lwt.t +val linux_md_start : t -> + components : UDisks_device.t list -> + options : string list -> + UDisks_device.t Lwt.t + +val linux_lvm2_lvcreate : t -> + group_uuid : string -> + name : string -> + size : int64 -> + num_stripes : int -> + stripe_size : int64 -> + num_mirrors : int -> + options : string list -> + fstype : string -> + fsoptions : string list -> + UDisks_device.t Lwt.t +val linux_lvm2_lvremove : t -> group_uuid : string -> uuid : string -> options : string list -> unit Lwt.t +val linux_lvm2_lvstart : t -> group_uuid : string -> uuid : string -> options : string list -> unit Lwt.t +val linux_lvm2_lvset_name : t -> group_uuid : string -> uuid : string -> name : string -> unit Lwt.t +val linux_lvm2_vgremove_pv : t -> vg_uuid : string -> pv_uuid : string -> options : string list -> unit Lwt.t +val linux_lvm2_vgadd_pv : t -> uuid : string -> physical_volume : UDisks_device.t -> options : string list -> unit Lwt.t +val linux_lvm2_vgset_name : t -> uuid : string -> name : string -> unit Lwt.t +val linux_lvm2_vgstop : t -> uuid : string -> options : string list -> unit Lwt.t +val linux_lvm2_vgstart : t -> uuid : string -> options : string list -> unit Lwt.t + +type all_spindown_timeouts_cookie + +val drive_set_all_spindown_timeouts : t -> timeout_seconds : int -> options : string list -> all_spindown_timeouts_cookie Lwt.t +val drive_unset_all_spindown_timeouts : t -> cookie : all_spindown_timeouts_cookie -> unit Lwt.t + +type inhibit_all_polling_cookie + +val drive_inhibit_all_polling : t -> options : string list -> inhibit_all_polling_cookie Lwt.t +val drive_uninhibit_all_polling : t -> cookie : inhibit_all_polling_cookie -> unit Lwt.t + +val find_device_by_major_minor : t -> device_major : int64 -> device_minor : int64 -> UDisks_device.t Lwt.t +val find_device_by_device_file : t -> device_file : string -> UDisks_device.t Lwt.t + +val enumerate_device_files : t -> string list Lwt.t +val enumerate_devices : t -> UDisks_device.t list Lwt.t +val enumerate_ports : t -> UDisks_port.t list Lwt.t +val enumerate_expanders : t -> UDisks_expander.t list Lwt.t +val enumerate_adapters : t -> UDisks_adapter.t list Lwt.t + +(** {6 Signals} *) + +val port_changed : t -> UDisks_port.t OBus_signal.t +val port_removed : t -> UDisks_port.t OBus_signal.t +val port_added : t -> UDisks_port.t OBus_signal.t + +val expander_changed : t -> UDisks_expander.t OBus_signal.t +val expander_removed : t -> UDisks_expander.t OBus_signal.t +val expander_added : t -> UDisks_expander.t OBus_signal.t + +val adapter_changed : t -> UDisks_adapter.t OBus_signal.t +val adapter_removed : t -> UDisks_adapter.t OBus_signal.t +val adapter_added : t -> UDisks_adapter.t OBus_signal.t + +val device_changed : t -> UDisks_device.t OBus_signal.t +val device_removed : t -> UDisks_device.t OBus_signal.t +val device_added : t -> UDisks_device.t OBus_signal.t + +type job = { + job_device : UDisks_device.t; + job_in_progress : bool; + (** Whether a job is currently in progress.</doc:summary *) + job_is_cancellable : bool; + (** Whether the job is cancellable *) + job_id : string; + (** The identifier of the job *) + job_num_tasks : int; + (** Number of tasks in the job *) + job_cur_task : int; + (** Current task number (zero-based offset) *) + job_cur_task_id : string; + (** Task identifier for current task *) + job_cur_task_percentage : float; + (** Percentage completed of current task (between 0 and 100, negative if unknown) *) +} + +val device_job_changed : t -> job OBus_signal.t + +(** {6 Properties} *) + +(** File-system informations *) +type fs = { + fs_id : string; + (** The name / identifier of the file system (such as ext3 or vfat), + similar to the contents of the Device:IdType property. *) + fs_name : string; + (** A human readable name for the file system such as "Linux + Ext3". *) + fs_supports_unix_owners : bool; + (** Whether the file system supports the UNIX owners model + (e.g. ext3 does, but vfat doesn't). *) + fs_can_mount : bool; + (** Whether the file system can be mounted. *) + fs_can_create : bool; + (** Whether the file system can be created on a device. *) + fs_max_label_len : int; + (** The maximum amount of bytes that the file system label can + hold. Set to zero if the file system doesn't support labels. *) + fs_supports_label_rename : bool; + (** Whether the label of the file system can be changed. *) + fs_supports_online_label_rename : bool; + (** Whether the label can be changed while the file system is + mounted. *) + fs_supports_fsck : bool; + (** Whether the file system can be checked. *) + fs_supports_online_fsck : bool; + (** Whether the file system can be checked while mounted. *) + fs_supports_resize_enlarge : bool; + (** Whether the file system can be enlarged. *) + fs_supports_online_resize_enlarge : bool; + (** Whether the file system can be enlarged while mounted. *) + fs_supports_resize_shrink : bool; + (** Whether the file system can be shrunk. *) + fs_supports_online_resize_shrink : bool; + (** Whether the file system can be shrunk while mounted. *) +} + +val known_filesystems : t -> fs list OBus_property.r +val supports_luks_devices : t -> bool OBus_property.r +val daemon_is_inhibited : t -> bool OBus_property.r +val daemon_version : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/udisks/uDisks_adapter.ml b/bindings/udisks/uDisks_adapter.ml new file mode 100644 index 0000000..9edfe00 --- /dev/null +++ b/bindings/udisks/uDisks_adapter.ml @@ -0,0 +1,38 @@ +(* + * uDisks_adapter.ml + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +include OBus_proxy.Private + +open UDisks_interfaces.Org_freedesktop_UDisks_Adapter + +let changed proxy = + OBus_signal.make s_Changed proxy + +let native_path proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy + +let vendor proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy + +let model proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy + +let driver proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Driver proxy + +let num_ports proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy) + +let fabric proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Fabric proxy + +let properties proxy = + OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface diff --git a/bindings/udisks/uDisks_adapter.mli b/bindings/udisks/uDisks_adapter.mli new file mode 100644 index 0000000..9c24d82 --- /dev/null +++ b/bindings/udisks/uDisks_adapter.mli @@ -0,0 +1,27 @@ +(* + * uDisks_adapter.mli + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UDisks adapter interface *) + +include OBus_proxy.Private + +(** {6 Signals} *) + +val changed : t -> unit OBus_signal.t + +(** {6 Properties} *) + +val fabric : t -> string OBus_property.r +val num_ports : t -> int OBus_property.r +val driver : t -> string OBus_property.r +val model : t -> string OBus_property.r +val vendor : t -> string OBus_property.r +val native_path : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/udisks/uDisks_device.ml b/bindings/udisks/uDisks_device.ml new file mode 100644 index 0000000..76a4544 --- /dev/null +++ b/bindings/udisks/uDisks_device.ml @@ -0,0 +1,620 @@ +(* + * uDisks_device.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +include OBus_proxy.Private + +(* +-----------------------------------------------------------------+ + | Types | + +-----------------------------------------------------------------+ *) + +type benchmark_result = { + bench_read_transfer_rate_results : (int64 * float) list; + bench_write_transfer_rate_results : (int64 * float) list; + bench_access_time_results : (int64 * float) list; +} + +type spindown_timeout_cookie = string +type inhibit_polling_cookie = string + +type process = { + pr_pid : int; + pr_uid : int; + pr_comamnd_line : string; +} + +type job = { + job_in_progress : bool; + job_id : string; + job_initiated_by_uid : int; + job_is_cancellable : bool; + job_cur_task_percentage : float; +} + +(* +-----------------------------------------------------------------+ + | D-Bus members | + +-----------------------------------------------------------------+ *) + +open UDisks_interfaces.Org_freedesktop_UDisks_Device + +let job_cancel proxy = + OBus_method.call m_JobCancel proxy () + +let partition_table_create proxy ~scheme ~options = + OBus_method.call m_PartitionTableCreate proxy (scheme, options) + +let partition_delete proxy ~options = + OBus_method.call m_PartitionDelete proxy options + +let partition_create proxy ~offset ~size ~typ ~label ~flags ~options ~fstype ~fsoptions = + let%lwt (context, created_device) = OBus_method.call_with_context m_PartitionCreate proxy (offset, size, typ, label, flags, options, fstype, fsoptions) in + let created_device = OBus_proxy.make (OBus_context.sender context) created_device in + return created_device + +let partition_modify proxy ~typ ~label ~flags = + OBus_method.call m_PartitionModify proxy (typ, label, flags) + +let filesystem_create proxy ~fstype ~options = + OBus_method.call m_FilesystemCreate proxy (fstype, options) + +let filesystem_set_label proxy ~new_label = + OBus_method.call m_FilesystemSetLabel proxy new_label + +let filesystem_mount proxy ~filesystem_type ~options = + OBus_method.call m_FilesystemMount proxy (filesystem_type, options) + +let filesystem_unmount proxy ~options = + OBus_method.call m_FilesystemUnmount proxy options + +let filesystem_check proxy ~options = + OBus_method.call m_FilesystemCheck proxy options + +let filesystem_list_open_files proxy = + let%lwt processes = OBus_method.call m_FilesystemListOpenFiles proxy () in + return + (List.map + (fun (x1, x2, x3) -> { + pr_pid = Int32.to_int x1; + pr_uid = Int32.to_int x2; + pr_comamnd_line = x3; + }) + processes) + +let luks_unlock proxy ~passphrase ~options = + let%lwt (context, cleartext_device) = OBus_method.call_with_context m_LuksUnlock proxy (passphrase, options) in + let cleartext_device = OBus_proxy.make (OBus_context.sender context) cleartext_device in + return cleartext_device + +let luks_lock proxy ~options = + OBus_method.call m_LuksLock proxy options + +let luks_change_passphrase proxy ~current_passphrase ~new_passphrase = + OBus_method.call m_LuksChangePassphrase proxy (current_passphrase, new_passphrase) + +let linux_md_add_spare proxy ~component ~options = + let component = OBus_proxy.path component in + OBus_method.call m_LinuxMdAddSpare proxy (component, options) + +let linux_md_expand proxy ~components ~options = + let components = List.map OBus_proxy.path components in + OBus_method.call m_LinuxMdExpand proxy (components, options) + +let linux_md_remove_component proxy ~component ~options = + let component = OBus_proxy.path component in + OBus_method.call m_LinuxMdRemoveComponent proxy (component, options) + +let linux_md_stop proxy ~options = + OBus_method.call m_LinuxMdStop proxy options + +let linux_lvm2_lvstop proxy ~options = + OBus_method.call m_LinuxLvm2LVStop proxy options + +let linux_md_check proxy ~options = + OBus_method.call m_LinuxMdCheck proxy options + +let drive_inhibit_polling proxy ~options = + OBus_method.call m_DriveInhibitPolling proxy options + +let drive_uninhibit_polling proxy ~cookie = + OBus_method.call m_DriveUninhibitPolling proxy cookie + +let drive_poll_media proxy = + OBus_method.call m_DrivePollMedia proxy () + +let drive_eject proxy ~options = + OBus_method.call m_DriveEject proxy options + +let drive_detach proxy ~options = + OBus_method.call m_DriveDetach proxy options + +let drive_set_spindown_timeout proxy ~timeout_seconds ~options = + let timeout_seconds = Int32.of_int timeout_seconds in + OBus_method.call m_DriveSetSpindownTimeout proxy (timeout_seconds, options) + +let drive_unset_spindown_timeout proxy ~cookie = + OBus_method.call m_DriveUnsetSpindownTimeout proxy cookie + +let drive_ata_smart_refresh_data proxy ~options = + OBus_method.call m_DriveAtaSmartRefreshData proxy options + +let drive_ata_smart_initiate_selftest proxy ~test ~options = + OBus_method.call m_DriveAtaSmartInitiateSelftest proxy (test, options) + +let drive_benchmark proxy ~do_write_benchmark ~options = + let%lwt (x1, x2, x3) = OBus_method.call m_DriveBenchmark proxy (do_write_benchmark, options) in + return { + bench_read_transfer_rate_results = x1; + bench_write_transfer_rate_results = x2; + bench_access_time_results = x3; + } + +let changed proxy = + OBus_signal.make s_Changed proxy + +let job_changed proxy = + OBus_signal.map + (fun (job_in_progress, job_is_cancellable, job_id, job_initiated_by_uid, job_percentage) -> { + job_in_progress = job_in_progress; + job_id = job_id; + job_initiated_by_uid = Int32.to_int job_initiated_by_uid; + job_is_cancellable = job_is_cancellable; + job_cur_task_percentage = job_percentage; + }) + (OBus_signal.make s_JobChanged proxy) + +let native_path proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy + +let device_detection_time proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceDetectionTime proxy + +let device_media_detection_time proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMediaDetectionTime proxy + +let device_major proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMajor proxy + +let device_minor proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMinor proxy + +let device_file proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFile proxy + +let device_file_presentation proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFilePresentation proxy + +let device_file_by_id proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFileById proxy + +let device_file_by_path proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceFileByPath proxy + +let device_is_system_internal proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsSystemInternal proxy + +let device_is_partition proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsPartition proxy + +let device_is_partition_table proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsPartitionTable proxy + +let device_is_removable proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsRemovable proxy + +let device_is_media_available proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaAvailable proxy + +let device_is_media_change_detected proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetected proxy + +let device_is_media_change_detection_polling proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionPolling proxy + +let device_is_media_change_detection_inhibitable proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionInhibitable proxy + +let device_is_media_change_detection_inhibited proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMediaChangeDetectionInhibited proxy + +let device_is_read_only proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsReadOnly proxy + +let device_is_drive proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsDrive proxy + +let device_is_optical_disc proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsOpticalDisc proxy + +let device_is_mounted proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsMounted proxy + +let device_mount_paths proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMountPaths proxy + +let device_mounted_by_uid proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceMountedByUid proxy) + +let device_is_luks proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLuks proxy + +let device_is_luks_cleartext proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLuksCleartext proxy + +let device_is_linux_md_component proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxMdComponent proxy + +let device_is_linux_md proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxMd proxy + +let device_is_linux_lvm2_lv proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLvm2LV proxy + +let device_is_linux_lvm2_pv proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLvm2PV proxy + +let device_is_linux_dmmp_component proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxDmmpComponent proxy + +let device_is_linux_dmmp proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxDmmp proxy + +let device_is_linux_loop proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceIsLinuxLoop proxy + +let device_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceSize proxy + +let device_block_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DeviceBlockSize proxy + +let device_presentation_hide proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationHide proxy + +let device_presentation_nopolicy proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationNopolicy proxy + +let device_presentation_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationName proxy + +let device_presentation_icon_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DevicePresentationIconName proxy + +let job_in_progress proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_JobInProgress proxy + +let job_id proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_JobId proxy + +let job_initiated_by_uid proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_JobInitiatedByUid proxy) + +let job_is_cancellable proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_JobIsCancellable proxy + +let job_percentage proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_JobPercentage proxy + +let id_usage proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_IdUsage proxy + +let id_type proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_IdType proxy + +let id_version proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_IdVersion proxy + +let id_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_IdUuid proxy + +let id_label proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_IdLabel proxy + +let luks_holder proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksHolder proxy) + +let luks_cleartext_slave proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksCleartextSlave proxy) + +let luks_cleartext_unlocked_by_uid proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LuksCleartextUnlockedByUid proxy) + +let partition_slave proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionSlave proxy) + +let partition_scheme proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionScheme proxy + +let partition_type proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionType proxy + +let partition_label proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionLabel proxy + +let partition_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionUuid proxy + +let partition_flags proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionFlags proxy + +let partition_number proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionNumber proxy) + +let partition_offset proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionOffset proxy + +let partition_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionSize proxy + +let partition_alignment_offset proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionAlignmentOffset proxy + +let partition_table_scheme proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionTableScheme proxy + +let partition_table_count proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_PartitionTableCount proxy) + +let drive_vendor proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveVendor proxy + +let drive_model proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveModel proxy + +let drive_revision proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveRevision proxy + +let drive_serial proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveSerial proxy + +let drive_wwn proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveWwn proxy + +let drive_rotation_rate proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveRotationRate proxy) + +let drive_write_cache proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveWriteCache proxy + +let drive_connection_interface proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveConnectionInterface proxy + +let drive_connection_speed proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveConnectionSpeed proxy + +let drive_media_compatibility proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveMediaCompatibility proxy + +let drive_media proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveMedia proxy + +let drive_is_media_ejectable proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveIsMediaEjectable proxy + +let drive_can_detach proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveCanDetach proxy + +let drive_can_spindown proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveCanSpindown proxy + +let drive_is_rotational proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveIsRotational proxy + +let drive_adapter proxy = + OBus_property.map_r_with_context + (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAdapter proxy) + +let drive_ports proxy = + OBus_property.map_r_with_context + (fun context x -> + List.map + (fun path -> + UDisks_port.of_proxy (OBus_proxy.make (OBus_context.sender context) path)) + x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_DrivePorts proxy) + +let drive_similar_devices proxy = + OBus_property.map_r_with_context + (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveSimilarDevices proxy) + +let optical_disc_is_blank proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsBlank proxy + +let optical_disc_is_appendable proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsAppendable proxy + +let optical_disc_is_closed proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscIsClosed proxy + +let optical_disc_num_tracks proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumTracks proxy) + +let optical_disc_num_audio_tracks proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumAudioTracks proxy) + +let optical_disc_num_sessions proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_OpticalDiscNumSessions proxy) + +let drive_ata_smart_is_available proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartIsAvailable proxy + +let drive_ata_smart_time_collected proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartTimeCollected proxy + +let drive_ata_smart_status proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartStatus proxy + +let drive_ata_smart_blob proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_DriveAtaSmartBlob proxy + +let linux_md_component_level proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentLevel proxy + +let linux_md_component_position proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentPosition proxy) + +let linux_md_component_num_raid_devices proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentNumRaidDevices proxy) + +let linux_md_component_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentUuid proxy + +let linux_md_component_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentName proxy + +let linux_md_component_home_host proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentHomeHost proxy + +let linux_md_component_version proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentVersion proxy + +let linux_md_component_holder proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentHolder proxy) + +let linux_md_component_state proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdComponentState proxy + +let linux_md_state proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdState proxy + +let linux_md_level proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdLevel proxy + +let linux_md_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdUuid proxy + +let linux_md_home_host proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdHomeHost proxy + +let linux_md_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdName proxy + +let linux_md_num_raid_devices proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdNumRaidDevices proxy) + +let linux_md_version proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdVersion proxy + +let linux_md_slaves proxy = + OBus_property.map_r_with_context + (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSlaves proxy) + +let linux_md_is_degraded proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdIsDegraded proxy + +let linux_md_sync_action proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncAction proxy + +let linux_md_sync_percentage proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncPercentage proxy + +let linux_md_sync_speed proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxMdSyncSpeed proxy + +let linux_lvm2_pvuuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVUuid proxy + +let linux_lvm2_pvnum_metadata_areas proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVNumMetadataAreas proxy) + +let linux_lvm2_pvgroup_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupName proxy + +let linux_lvm2_pvgroup_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupUuid proxy + +let linux_lvm2_pvgroup_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupSize proxy + +let linux_lvm2_pvgroup_unallocated_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupUnallocatedSize proxy + +let linux_lvm2_pvgroup_sequence_number proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupSequenceNumber proxy + +let linux_lvm2_pvgroup_extent_size proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupExtentSize proxy + +let linux_lvm2_pvgroup_physical_volumes proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupPhysicalVolumes proxy + +let linux_lvm2_pvgroup_logical_volumes proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2PVGroupLogicalVolumes proxy + +let linux_lvm2_lvname proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVName proxy + +let linux_lvm2_lvuuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVUuid proxy + +let linux_lvm2_lvgroup_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVGroupName proxy + +let linux_lvm2_lvgroup_uuid proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLvm2LVGroupUuid proxy + +let linux_dmmp_component_holder proxy = + OBus_property.map_r_with_context + (fun context x -> OBus_proxy.make (OBus_context.sender context) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpComponentHolder proxy) + +let linux_dmmp_name proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpName proxy + +let linux_dmmp_slaves proxy = + OBus_property.map_r_with_context + (fun context x -> List.map (fun path -> OBus_proxy.make (OBus_context.sender context) path) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpSlaves proxy) + +let linux_dmmp_parameters proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxDmmpParameters proxy + +let linux_loop_filename proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_LinuxLoopFilename proxy + +let properties proxy = + OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface + diff --git a/bindings/udisks/uDisks_device.mli b/bindings/udisks/uDisks_device.mli new file mode 100644 index 0000000..3516475 --- /dev/null +++ b/bindings/udisks/uDisks_device.mli @@ -0,0 +1,240 @@ +(* + * uDisks_device.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UDisks device interface *) + +include OBus_proxy.Private + +(** {6 Methods} *) + +type benchmark_result = { + bench_read_transfer_rate_results : (int64 * float) list; + (** An array of pairs where the first element is the offset and the + second element is the measured read transfer rate (in bytes/sec) + at the given offset. *) + bench_write_transfer_rate_results : (int64 * float) list; + (** An array of pairs where the first element is the offset and the + second element is the measured read transfer rate (in bytes/sec) + at the given offset. This is an empty array unless write + benchmarking has been requested. *) + bench_access_time_results : (int64 * float) list; + (** An array of pairs where the first element is the offset and the + second element the amount of time (in seconds) it took to seek + to the position. *) +} + +val drive_benchmark : t -> do_write_benchmark : bool -> options : string list -> benchmark_result Lwt.t + +val drive_ata_smart_initiate_selftest : t -> test : string -> options : string list -> unit Lwt.t +val drive_ata_smart_refresh_data : t -> options : string list -> unit Lwt.t + +type spindown_timeout_cookie + +val drive_set_spindown_timeout : t -> timeout_seconds : int -> options : string list -> spindown_timeout_cookie Lwt.t +val drive_unset_spindown_timeout : t -> cookie : spindown_timeout_cookie -> unit Lwt.t + +val drive_detach : t -> options : string list -> unit Lwt.t +val drive_eject : t -> options : string list -> unit Lwt.t +val drive_poll_media : t -> unit Lwt.t + +type inhibit_polling_cookie + +val drive_inhibit_polling : t -> options : string list -> inhibit_polling_cookie Lwt.t +val drive_uninhibit_polling : t -> cookie : inhibit_polling_cookie -> unit Lwt.t + +val linux_md_check : t -> options : string list -> int64 Lwt.t +val linux_lvm2_lvstop : t -> options : string list -> unit Lwt.t + +val linux_md_stop : t -> options : string list -> unit Lwt.t +val linux_md_remove_component : t -> component : t -> options : string list -> unit Lwt.t +val linux_md_expand : t -> components : t list -> options : string list -> unit Lwt.t +val linux_md_add_spare : t -> component : t -> options : string list -> unit Lwt.t + +val luks_change_passphrase : t -> current_passphrase : string -> new_passphrase : string -> unit Lwt.t +val luks_lock : t -> options : string list -> unit Lwt.t +val luks_unlock : t -> passphrase : string -> options : string list -> t Lwt.t + +type process = { + pr_pid : int; + pr_uid : int; + pr_comamnd_line : string; +} + +val filesystem_list_open_files : t -> process list Lwt.t +val filesystem_check : t -> options : string list -> bool Lwt.t +val filesystem_unmount : t -> options : string list -> unit Lwt.t +val filesystem_mount : t -> filesystem_type : string -> options : string list -> string Lwt.t +val filesystem_set_label : t -> new_label : string -> unit Lwt.t +val filesystem_create : t -> fstype : string -> options : string list -> unit Lwt.t + +val partition_modify : t -> typ : string -> label : string -> flags : string list -> unit Lwt.t +val partition_create : t -> offset : int64 -> size : int64 -> typ : string -> label : string -> flags : string list -> options : string list -> fstype : string -> fsoptions : string list -> t Lwt.t +val partition_delete : t -> options : string list -> unit Lwt.t +val partition_table_create : t -> scheme : string -> options : string list -> unit Lwt.t + +val job_cancel : t -> unit Lwt.t + +(** {6 Signals} *) + +(** A job description *) +type job = { + job_in_progress : bool; + (** Whether a job is currently in progress *) + + job_id : string; + (** The identifier of the job *) + + job_initiated_by_uid : int; + (** he UNIX user id of the user who initiated the job *) + + job_is_cancellable : bool; + (** Whether the job is cancellable *) + + job_cur_task_percentage : float; + (** Percentage completed of current task (between 0 and 100, + negative if unknown) *) +} + +val job_changed : t -> job OBus_signal.t +val changed : t -> unit OBus_signal.t + +(** {6 Properties} *) + +val linux_dmmp_parameters : t -> string OBus_property.r +val linux_dmmp_slaves : t -> t list OBus_property.r +val linux_dmmp_name : t -> string OBus_property.r +val linux_dmmp_component_holder : t -> t OBus_property.r +val linux_lvm2_lvgroup_uuid : t -> string OBus_property.r +val linux_lvm2_lvgroup_name : t -> string OBus_property.r +val linux_lvm2_lvuuid : t -> string OBus_property.r +val linux_lvm2_lvname : t -> string OBus_property.r +val linux_lvm2_pvgroup_logical_volumes : t -> string list OBus_property.r +val linux_lvm2_pvgroup_physical_volumes : t -> string list OBus_property.r +val linux_lvm2_pvgroup_extent_size : t -> int64 OBus_property.r +val linux_lvm2_pvgroup_sequence_number : t -> int64 OBus_property.r +val linux_lvm2_pvgroup_unallocated_size : t -> int64 OBus_property.r +val linux_lvm2_pvgroup_size : t -> int64 OBus_property.r +val linux_lvm2_pvgroup_uuid : t -> string OBus_property.r +val linux_lvm2_pvgroup_name : t -> string OBus_property.r +val linux_lvm2_pvnum_metadata_areas : t -> int OBus_property.r +val linux_lvm2_pvuuid : t -> string OBus_property.r +val linux_md_sync_speed : t -> int64 OBus_property.r +val linux_md_sync_percentage : t -> float OBus_property.r +val linux_md_sync_action : t -> string OBus_property.r +val linux_md_is_degraded : t -> bool OBus_property.r +val linux_md_slaves : t -> t list OBus_property.r +val linux_md_version : t -> string OBus_property.r +val linux_md_num_raid_devices : t -> int OBus_property.r +val linux_md_name : t -> string OBus_property.r +val linux_md_home_host : t -> string OBus_property.r +val linux_md_uuid : t -> string OBus_property.r +val linux_md_level : t -> string OBus_property.r +val linux_md_state : t -> string OBus_property.r +val linux_md_component_state : t -> string list OBus_property.r +val linux_md_component_holder : t -> t OBus_property.r +val linux_md_component_version : t -> string OBus_property.r +val linux_md_component_home_host : t -> string OBus_property.r +val linux_md_component_name : t -> string OBus_property.r +val linux_md_component_uuid : t -> string OBus_property.r +val linux_md_component_num_raid_devices : t -> int OBus_property.r +val linux_md_component_position : t -> int OBus_property.r +val linux_md_component_level : t -> string OBus_property.r +val drive_ata_smart_blob : t -> string OBus_property.r +val drive_ata_smart_status : t -> string OBus_property.r +val drive_ata_smart_time_collected : t -> int64 OBus_property.r +val drive_ata_smart_is_available : t -> bool OBus_property.r +val optical_disc_num_sessions : t -> int OBus_property.r +val optical_disc_num_audio_tracks : t -> int OBus_property.r +val optical_disc_num_tracks : t -> int OBus_property.r +val optical_disc_is_closed : t -> bool OBus_property.r +val optical_disc_is_appendable : t -> bool OBus_property.r +val optical_disc_is_blank : t -> bool OBus_property.r +val drive_similar_devices : t -> t list OBus_property.r +val drive_ports : t -> UDisks_port.t list OBus_property.r +val drive_adapter : t -> UDisks_adapter.t OBus_property.r +val drive_is_rotational : t -> bool OBus_property.r +val drive_can_spindown : t -> bool OBus_property.r +val drive_can_detach : t -> bool OBus_property.r +val drive_is_media_ejectable : t -> bool OBus_property.r +val drive_media : t -> string OBus_property.r +val drive_media_compatibility : t -> string list OBus_property.r +val drive_connection_speed : t -> int64 OBus_property.r +val drive_connection_interface : t -> string OBus_property.r +val drive_write_cache : t -> string OBus_property.r +val drive_rotation_rate : t -> int OBus_property.r +val drive_wwn : t -> string OBus_property.r +val drive_serial : t -> string OBus_property.r +val drive_revision : t -> string OBus_property.r +val drive_model : t -> string OBus_property.r +val drive_vendor : t -> string OBus_property.r +val partition_table_count : t -> int OBus_property.r +val partition_table_scheme : t -> string OBus_property.r +val partition_alignment_offset : t -> int64 OBus_property.r +val partition_size : t -> int64 OBus_property.r +val partition_offset : t -> int64 OBus_property.r +val partition_number : t -> int OBus_property.r +val partition_flags : t -> string list OBus_property.r +val partition_uuid : t -> string OBus_property.r +val partition_label : t -> string OBus_property.r +val partition_type : t -> string OBus_property.r +val partition_scheme : t -> string OBus_property.r +val partition_slave : t -> t OBus_property.r +val luks_cleartext_unlocked_by_uid : t -> int OBus_property.r +val luks_cleartext_slave : t -> t OBus_property.r +val luks_holder : t -> t OBus_property.r +val id_label : t -> string OBus_property.r +val id_uuid : t -> string OBus_property.r +val id_version : t -> string OBus_property.r +val id_type : t -> string OBus_property.r +val id_usage : t -> string OBus_property.r +val job_percentage : t -> float OBus_property.r +val job_is_cancellable : t -> bool OBus_property.r +val job_initiated_by_uid : t -> int OBus_property.r +val job_id : t -> string OBus_property.r +val job_in_progress : t -> bool OBus_property.r +val device_presentation_icon_name : t -> string OBus_property.r +val device_presentation_name : t -> string OBus_property.r +val device_presentation_nopolicy : t -> bool OBus_property.r +val device_presentation_hide : t -> bool OBus_property.r +val device_block_size : t -> int64 OBus_property.r +val device_size : t -> int64 OBus_property.r +val device_is_linux_dmmp : t -> bool OBus_property.r +val device_is_linux_dmmp_component : t -> bool OBus_property.r +val device_is_linux_lvm2_pv : t -> bool OBus_property.r +val device_is_linux_lvm2_lv : t -> bool OBus_property.r +val device_is_linux_md : t -> bool OBus_property.r +val device_is_linux_md_component : t -> bool OBus_property.r +val device_is_luks_cleartext : t -> bool OBus_property.r +val device_is_luks : t -> bool OBus_property.r +val device_mounted_by_uid : t -> int OBus_property.r +val device_mount_paths : t -> string list OBus_property.r +val device_is_mounted : t -> bool OBus_property.r +val device_is_optical_disc : t -> bool OBus_property.r +val device_is_drive : t -> bool OBus_property.r +val device_is_read_only : t -> bool OBus_property.r +val device_is_media_change_detection_inhibited : t -> bool OBus_property.r +val device_is_media_change_detection_inhibitable : t -> bool OBus_property.r +val device_is_media_change_detection_polling : t -> bool OBus_property.r +val device_is_media_change_detected : t -> bool OBus_property.r +val device_is_media_available : t -> bool OBus_property.r +val device_is_removable : t -> bool OBus_property.r +val device_is_partition_table : t -> bool OBus_property.r +val device_is_partition : t -> bool OBus_property.r +val device_is_system_internal : t -> bool OBus_property.r +val device_file_by_path : t -> string list OBus_property.r +val device_file_by_id : t -> string list OBus_property.r +val device_file_presentation : t -> string OBus_property.r +val device_file : t -> string OBus_property.r +val device_minor : t -> int64 OBus_property.r +val device_major : t -> int64 OBus_property.r +val device_media_detection_time : t -> int64 OBus_property.r +val device_detection_time : t -> int64 OBus_property.r +val native_path : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/udisks/uDisks_expander.ml b/bindings/udisks/uDisks_expander.ml new file mode 100644 index 0000000..25e3cd8 --- /dev/null +++ b/bindings/udisks/uDisks_expander.ml @@ -0,0 +1,45 @@ +(* + * uDisks_expander.ml + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +include OBus_proxy.Private + +open UDisks_interfaces.Org_freedesktop_UDisks_Expander + +let changed proxy = + OBus_signal.make s_Changed proxy + +let native_path proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy + +let vendor proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Vendor proxy + +let model proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Model proxy + +let revision proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_Revision proxy + +let num_ports proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_NumPorts proxy) + +let upstream_ports proxy = + OBus_property.map_r_with_context + (fun context x -> List.map (fun path -> UDisks_port.of_proxy ( OBus_proxy.make (OBus_context.sender context) path)) x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_UpstreamPorts proxy) + +let adapter proxy = + OBus_property.map_r_with_context + (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy) + +let properties proxy = + OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface diff --git a/bindings/udisks/uDisks_expander.mli b/bindings/udisks/uDisks_expander.mli new file mode 100644 index 0000000..ccdbbab --- /dev/null +++ b/bindings/udisks/uDisks_expander.mli @@ -0,0 +1,28 @@ +(* + * uDisks_expander.mli + * ------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UDisks expander interface *) + +include OBus_proxy.Private + +(** {6 Signals} *) + +val changed : t -> unit OBus_signal.t + +(** {6 Properties} *) + +val native_path : t -> string OBus_property.r +val vendor : t -> string OBus_property.r +val model : t -> string OBus_property.r +val revision : t -> string OBus_property.r +val num_ports : t -> int OBus_property.r +val upstream_ports : t -> UDisks_port.t list OBus_property.r +val adapter : t -> UDisks_adapter.t OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/udisks/uDisks_interfaces.obus b/bindings/udisks/uDisks_interfaces.obus new file mode 100644 index 0000000..02f73d4 --- /dev/null +++ b/bindings/udisks/uDisks_interfaces.obus @@ -0,0 +1,249 @@ +(* + * uDisks_interfaces.obus + * ---------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.UDisks { + method EnumerateAdapters : () -> (devices : object_path array) + method EnumerateExpanders : () -> (devices : object_path array) + method EnumeratePorts : () -> (devices : object_path array) + method EnumerateDevices : () -> (devices : object_path array) + method EnumerateDeviceFiles : () -> (device_files : string array) + method FindDeviceByDeviceFile : (device_file : string) -> (device : object_path) + method FindDeviceByMajorMinor : (device_major : int64, device_minor : int64) -> (device : object_path) + method DriveInhibitAllPolling : (options : string array) -> (cookie : string) + method DriveUninhibitAllPolling : (cookie : string) -> () + method DriveSetAllSpindownTimeouts : (timeout_seconds : int32, options : string array) -> (cookie : string) + method DriveUnsetAllSpindownTimeouts : (cookie : string) -> () + method LinuxLvm2VGStart : (uuid : string, options : string array) -> () + method LinuxLvm2VGStop : (uuid : string, options : string array) -> () + method LinuxLvm2VGSetName : (uuid : string, name : string) -> () + method LinuxLvm2VGAddPV : (uuid : string, physical_volume : object_path, options : string array) -> () + method LinuxLvm2VGRemovePV : (vg_uuid : string, pv_uuid : string, options : string array) -> () + method LinuxLvm2LVSetName : (group_uuid : string, uuid : string, name : string) -> () + method LinuxLvm2LVStart : (group_uuid : string, uuid : string, options : string array) -> () + method LinuxLvm2LVRemove : (group_uuid : string, uuid : string, options : string array) -> () + method LinuxLvm2LVCreate : (group_uuid : string, name : string, size : uint64, num_stripes : uint32, stripe_size : uint64, num_mirrors : uint32, options : string array, fstype : string, fsoptions : string array) -> (created_device : object_path) + method LinuxMdStart : (components : object_path array, options : string array) -> (device : object_path) + method LinuxMdCreate : (components : object_path array, level : string, stripe_size : uint64, name : string, options : string array) -> (device : object_path) + method Inhibit : () -> (cookie : string) + method Uninhibit : (cookie : string) -> () + signal DeviceAdded : (device : object_path) + signal DeviceRemoved : (device : object_path) + signal DeviceChanged : (device : object_path) + signal DeviceJobChanged : (device : object_path, job_in_progress : boolean, job_is_cancellable : boolean, job_id : string, job_num_tasks : int32, job_cur_task : int32, job_cur_task_id : string, job_cur_task_percentage : double) + signal AdapterAdded : (adapter : object_path) + signal AdapterRemoved : (adapter : object_path) + signal AdapterChanged : (adapter : object_path) + signal ExpanderAdded : (expander : object_path) + signal ExpanderRemoved : (expander : object_path) + signal ExpanderChanged : (expander : object_path) + signal PortAdded : (port : object_path) + signal PortRemoved : (port : object_path) + signal PortChanged : (port : object_path) + property_r DaemonVersion : string + property_r DaemonIsInhibited : boolean + property_r SupportsLuksDevices : boolean + property_r KnownFilesystems : (string * string * boolean * boolean * boolean * uint32 * boolean * boolean * boolean * boolean * boolean * boolean * boolean * boolean) array +} + +interface org.freedesktop.UDisks.Adapter { + signal Changed : () + property_r NativePath : string + property_r Vendor : string + property_r Model : string + property_r Driver : string + property_r NumPorts : uint32 + property_r Fabric : string +} + +interface org.freedesktop.UDisks.Device { + method JobCancel : () -> () + method PartitionTableCreate : (scheme : string, options : string array) -> () + method PartitionDelete : (options : string array) -> () + method PartitionCreate : (offset : uint64, size : uint64, type : string, label : string, flags : string array, options : string array, fstype : string, fsoptions : string array) -> (created_device : object_path) + method PartitionModify : (type : string, label : string, flags : string array) -> () + method FilesystemCreate : (fstype : string, options : string array) -> () + method FilesystemSetLabel : (new_label : string) -> () + method FilesystemMount : (filesystem_type : string, options : string array) -> (mount_path : string) + method FilesystemUnmount : (options : string array) -> () + method FilesystemCheck : (options : string array) -> (is_clean : boolean) + method FilesystemListOpenFiles : () -> (processes : (uint32 * uint32 * string) array) + method LuksUnlock : (passphrase : string, options : string array) -> (cleartext_device : object_path) + method LuksLock : (options : string array) -> () + method LuksChangePassphrase : (current_passphrase : string, new_passphrase : string) -> () + method LinuxMdAddSpare : (component : object_path, options : string array) -> () + method LinuxMdExpand : (components : object_path array, options : string array) -> () + method LinuxMdRemoveComponent : (component : object_path, options : string array) -> () + method LinuxMdStop : (options : string array) -> () + method LinuxLvm2LVStop : (options : string array) -> () + method LinuxMdCheck : (options : string array) -> (number_of_errors : uint64) + method DriveInhibitPolling : (options : string array) -> (cookie : string) + method DriveUninhibitPolling : (cookie : string) -> () + method DrivePollMedia : () -> () + method DriveEject : (options : string array) -> () + method DriveDetach : (options : string array) -> () + method DriveSetSpindownTimeout : (timeout_seconds : int32, options : string array) -> (cookie : string) + method DriveUnsetSpindownTimeout : (cookie : string) -> () + method DriveAtaSmartRefreshData : (options : string array) -> () + method DriveAtaSmartInitiateSelftest : (test : string, options : string array) -> () + method DriveBenchmark : (do_write_benchmark : boolean, options : string array) -> (read_transfer_rate_results : (uint64 * double) array, write_transfer_rate_results : (uint64 * double) array, access_time_results : (uint64 * double) array) + signal Changed : () + signal JobChanged : (job_in_progress : boolean, job_is_cancellable : boolean, job_id : string, job_initiated_by_uid : uint32, job_percentage : double) + property_r NativePath : string + property_r DeviceDetectionTime : uint64 + property_r DeviceMediaDetectionTime : uint64 + property_r DeviceMajor : int64 + property_r DeviceMinor : int64 + property_r DeviceFile : string + property_r DeviceFilePresentation : string + property_r DeviceFileById : string array + property_r DeviceFileByPath : string array + property_r DeviceIsSystemInternal : boolean + property_r DeviceIsPartition : boolean + property_r DeviceIsPartitionTable : boolean + property_r DeviceIsRemovable : boolean + property_r DeviceIsMediaAvailable : boolean + property_r DeviceIsMediaChangeDetected : boolean + property_r DeviceIsMediaChangeDetectionPolling : boolean + property_r DeviceIsMediaChangeDetectionInhibitable : boolean + property_r DeviceIsMediaChangeDetectionInhibited : boolean + property_r DeviceIsReadOnly : boolean + property_r DeviceIsDrive : boolean + property_r DeviceIsOpticalDisc : boolean + property_r DeviceIsMounted : boolean + property_r DeviceMountPaths : string array + property_r DeviceMountedByUid : uint32 + property_r DeviceIsLuks : boolean + property_r DeviceIsLuksCleartext : boolean + property_r DeviceIsLinuxMdComponent : boolean + property_r DeviceIsLinuxMd : boolean + property_r DeviceIsLinuxLvm2LV : boolean + property_r DeviceIsLinuxLvm2PV : boolean + property_r DeviceIsLinuxDmmpComponent : boolean + property_r DeviceIsLinuxDmmp : boolean + property_r DeviceIsLinuxLoop : boolean + property_r DeviceSize : uint64 + property_r DeviceBlockSize : uint64 + property_r DevicePresentationHide : boolean + property_r DevicePresentationNopolicy : boolean + property_r DevicePresentationName : string + property_r DevicePresentationIconName : string + property_r JobInProgress : boolean + property_r JobId : string + property_r JobInitiatedByUid : uint32 + property_r JobIsCancellable : boolean + property_r JobPercentage : double + property_r IdUsage : string + property_r IdType : string + property_r IdVersion : string + property_r IdUuid : string + property_r IdLabel : string + property_r LuksHolder : object_path + property_r LuksCleartextSlave : object_path + property_r LuksCleartextUnlockedByUid : uint32 + property_r PartitionSlave : object_path + property_r PartitionScheme : string + property_r PartitionType : string + property_r PartitionLabel : string + property_r PartitionUuid : string + property_r PartitionFlags : string array + property_r PartitionNumber : int32 + property_r PartitionOffset : uint64 + property_r PartitionSize : uint64 + property_r PartitionAlignmentOffset : uint64 + property_r PartitionTableScheme : string + property_r PartitionTableCount : int32 + property_r DriveVendor : string + property_r DriveModel : string + property_r DriveRevision : string + property_r DriveSerial : string + property_r DriveWwn : string + property_r DriveRotationRate : uint32 + property_r DriveWriteCache : string + property_r DriveConnectionInterface : string + property_r DriveConnectionSpeed : uint64 + property_r DriveMediaCompatibility : string array + property_r DriveMedia : string + property_r DriveIsMediaEjectable : boolean + property_r DriveCanDetach : boolean + property_r DriveCanSpindown : boolean + property_r DriveIsRotational : boolean + property_r DriveAdapter : object_path + property_r DrivePorts : object_path array + property_r DriveSimilarDevices : object_path array + property_r OpticalDiscIsBlank : boolean + property_r OpticalDiscIsAppendable : boolean + property_r OpticalDiscIsClosed : boolean + property_r OpticalDiscNumTracks : uint32 + property_r OpticalDiscNumAudioTracks : uint32 + property_r OpticalDiscNumSessions : uint32 + property_r DriveAtaSmartIsAvailable : boolean + property_r DriveAtaSmartTimeCollected : uint64 + property_r DriveAtaSmartStatus : string + property_r DriveAtaSmartBlob : byte array + property_r LinuxMdComponentLevel : string + property_r LinuxMdComponentPosition : int32 + property_r LinuxMdComponentNumRaidDevices : int32 + property_r LinuxMdComponentUuid : string + property_r LinuxMdComponentName : string + property_r LinuxMdComponentHomeHost : string + property_r LinuxMdComponentVersion : string + property_r LinuxMdComponentHolder : object_path + property_r LinuxMdComponentState : string array + property_r LinuxMdState : string + property_r LinuxMdLevel : string + property_r LinuxMdUuid : string + property_r LinuxMdHomeHost : string + property_r LinuxMdName : string + property_r LinuxMdNumRaidDevices : int32 + property_r LinuxMdVersion : string + property_r LinuxMdSlaves : object_path array + property_r LinuxMdIsDegraded : boolean + property_r LinuxMdSyncAction : string + property_r LinuxMdSyncPercentage : double + property_r LinuxMdSyncSpeed : uint64 + property_r LinuxLvm2PVUuid : string + property_r LinuxLvm2PVNumMetadataAreas : uint32 + property_r LinuxLvm2PVGroupName : string + property_r LinuxLvm2PVGroupUuid : string + property_r LinuxLvm2PVGroupSize : uint64 + property_r LinuxLvm2PVGroupUnallocatedSize : uint64 + property_r LinuxLvm2PVGroupSequenceNumber : uint64 + property_r LinuxLvm2PVGroupExtentSize : uint64 + property_r LinuxLvm2PVGroupPhysicalVolumes : string array + property_r LinuxLvm2PVGroupLogicalVolumes : string array + property_r LinuxLvm2LVName : string + property_r LinuxLvm2LVUuid : string + property_r LinuxLvm2LVGroupName : string + property_r LinuxLvm2LVGroupUuid : string + property_r LinuxDmmpComponentHolder : object_path + property_r LinuxDmmpName : string + property_r LinuxDmmpSlaves : object_path array + property_r LinuxDmmpParameters : string + property_r LinuxLoopFilename : string +} + +interface org.freedesktop.UDisks.Expander { + signal Changed : () + property_r NativePath : string + property_r Vendor : string + property_r Model : string + property_r Revision : string + property_r NumPorts : uint32 + property_r UpstreamPorts : object_path array + property_r Adapter : object_path +} + +interface org.freedesktop.UDisks.Port { + signal Changed : () + property_r NativePath : string + property_r Adapter : object_path + property_r Parent : object_path + property_r Number : int32 + property_r ConnectorType : string +} diff --git a/bindings/udisks/uDisks_monitor.ml b/bindings/udisks/uDisks_monitor.ml new file mode 100644 index 0000000..faf9de1 --- /dev/null +++ b/bindings/udisks/uDisks_monitor.ml @@ -0,0 +1,35 @@ +(* + * uDisks_monitor.ml + * ----------------- + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt_react +open Lwt + +module String_map = Map.Make(String) + +let changed interface = + OBus_member.Signal.make + ~interface + ~member:"Changed" + ~args:OBus_value.arg0 + ~annotations:[] + +let monitor proxy interface switch = + let%lwt event = + OBus_signal.connect ~switch + (OBus_signal.with_context + (OBus_signal.make (changed interface) proxy)) + and context, dict = OBus_property.get_all_no_cache proxy interface in + return (S.hold + ~eq:(String_map.equal (=)) + (OBus_property.map_of_list context dict) + (E.map_s + (fun (context, ()) -> + let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in + return (OBus_property.map_of_list context dict)) + event)) diff --git a/bindings/udisks/uDisks_monitor.mli b/bindings/udisks/uDisks_monitor.mli new file mode 100644 index 0000000..bc31320 --- /dev/null +++ b/bindings/udisks/uDisks_monitor.mli @@ -0,0 +1,13 @@ +(* + * uDisks_monitor.mli + * ------------------ + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Properties monitoring *) + +val monitor : OBus_property.monitor + (** Monitor for properties of udisk interfaces. *) diff --git a/bindings/udisks/uDisks_port.ml b/bindings/udisks/uDisks_port.ml new file mode 100644 index 0000000..7aa2e31 --- /dev/null +++ b/bindings/udisks/uDisks_port.ml @@ -0,0 +1,39 @@ +(* + * uDisks_port.ml + * -------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +include OBus_proxy.Private + +open UDisks_interfaces.Org_freedesktop_UDisks_Port + +let changed proxy = + OBus_signal.make s_Changed proxy + +let native_path proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_NativePath proxy + +let adapter proxy = + OBus_property.map_r_with_context + (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_Adapter proxy) + +let parent proxy = + OBus_property.map_r_with_context + (fun context x -> UDisks_adapter.of_proxy (OBus_proxy.make (OBus_context.sender context) x)) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_Parent proxy) + +let number proxy = + OBus_property.map_r + (fun x -> Int32.to_int x) + (OBus_property.make ~monitor:UDisks_monitor.monitor p_Number proxy) + +let connector_type proxy = + OBus_property.make ~monitor:UDisks_monitor.monitor p_ConnectorType proxy + +let properties proxy = + OBus_property.group ~monitor:UDisks_monitor.monitor proxy interface diff --git a/bindings/udisks/uDisks_port.mli b/bindings/udisks/uDisks_port.mli new file mode 100644 index 0000000..28aa67e --- /dev/null +++ b/bindings/udisks/uDisks_port.mli @@ -0,0 +1,26 @@ +(* + * uDisks_port.mli + * --------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UDisks port interface *) + +include OBus_proxy.Private + +(** {6 Signals} *) + +val changed : t -> unit OBus_signal.t + +(** {6 Properties} *) + +val connector_type : t -> string OBus_property.r +val number : t -> int OBus_property.r +val parent : t -> UDisks_adapter.t OBus_property.r +val adapter : t -> UDisks_adapter.t OBus_property.r +val native_path : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/upower/dune b/bindings/upower/dune new file mode 100644 index 0000000..23caec5 --- /dev/null +++ b/bindings/upower/dune @@ -0,0 +1,12 @@ +(library + (name obus_upower) + (public_name obus.upower) + (wrapped false) + (libraries lwt obus) + (preprocess (pps lwt_ppx ppx_obus))) + +(rule + (targets uPower_interfaces.ml uPower_interfaces.mli) + (deps uPower_interfaces.obus) + (action + (run obus-gen-interface -keep-common -o uPower_interfaces %{deps}))) diff --git a/bindings/upower/uPower.ml b/bindings/upower/uPower.ml new file mode 100644 index 0000000..caaf4d6 --- /dev/null +++ b/bindings/upower/uPower.ml @@ -0,0 +1,97 @@ +(* + * uPower.ml + * --------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +include OBus_peer.Private + +let general_error = "org.freedesktop.UPower.GeneralError" + +let daemon () = + let%lwt bus = OBus_bus.system () in + return (OBus_peer.make bus "org.freedesktop.UPower") + +open UPower_interfaces.Org_freedesktop_UPower + +let proxy daemon = OBus_proxy.make daemon ["org"; "freedesktop"; "UPower"] + +let enumerate_devices daemon = + let%lwt (context, devices) = OBus_method.call_with_context m_EnumerateDevices (proxy daemon) () in + return + (List.map + (fun path -> + UPower_device.of_proxy + (OBus_proxy.make (OBus_context.sender context) path)) + devices) + +let device_added daemon = + OBus_signal.map_with_context + (fun context device -> + UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) + (OBus_signal.make s_DeviceAdded (proxy daemon)) + +let device_removed daemon = + OBus_signal.map_with_context + (fun context device -> + UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) + (OBus_signal.make s_DeviceRemoved (proxy daemon)) + +let device_changed daemon = + OBus_signal.map_with_context + (fun context device -> + UPower_device.of_proxy (OBus_proxy.make (OBus_context.sender context) (OBus_path.of_string device))) + (OBus_signal.make s_DeviceChanged (proxy daemon)) + +let changed daemon = + OBus_signal.make s_Changed (proxy daemon) + +let sleeping daemon = + OBus_signal.make s_Sleeping (proxy daemon) + +let resuming daemon = + OBus_signal.make s_Resuming (proxy daemon) + +let about_to_sleep daemon = + OBus_method.call m_AboutToSleep (proxy daemon) () + +let suspend daemon = + OBus_method.call m_Suspend (proxy daemon) () + +let suspend_allowed daemon = + OBus_method.call m_SuspendAllowed (proxy daemon) () + +let hibernate daemon = + OBus_method.call m_Hibernate (proxy daemon) () + +let hibernate_allowed daemon = + OBus_method.call m_HibernateAllowed (proxy daemon) () + +let daemon_version daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_DaemonVersion (proxy daemon) + +let can_suspend daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_CanSuspend (proxy daemon) + +let can_hibernate daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_CanHibernate (proxy daemon) + +let on_battery daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_OnBattery (proxy daemon) + +let on_low_battery daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_OnLowBattery (proxy daemon) + +let lid_is_closed daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsClosed (proxy daemon) + +let lid_is_present daemon = + OBus_property.make ~monitor:UPower_monitor.monitor p_LidIsPresent (proxy daemon) + +let properties daemon = + OBus_property.group ~monitor:UPower_monitor.monitor (proxy daemon) interface diff --git a/bindings/upower/uPower.mli b/bindings/upower/uPower.mli new file mode 100644 index 0000000..46c2fcb --- /dev/null +++ b/bindings/upower/uPower.mli @@ -0,0 +1,47 @@ +(* + * uPower.mli + * ---------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UPower main interface *) + +include OBus_peer.Private + +val daemon : unit -> t Lwt.t + (** [daemon ()] returns the peer object for the upower daemon *) + +val general_error : OBus_error.name + +(** {6 Methods} *) + +val hibernate_allowed : t -> bool Lwt.t +val hibernate : t -> unit Lwt.t +val suspend_allowed : t -> bool Lwt.t +val suspend : t -> unit Lwt.t +val about_to_sleep : t -> unit Lwt.t +val enumerate_devices : t -> UPower_device.t list Lwt.t + +(** {6 Signals} *) + +val resuming : t -> unit OBus_signal.t +val sleeping : t -> unit OBus_signal.t +val changed : t -> unit OBus_signal.t +val device_changed : t -> UPower_device.t OBus_signal.t +val device_removed : t -> UPower_device.t OBus_signal.t +val device_added : t -> UPower_device.t OBus_signal.t + +(** {6 Properties} *) + +val lid_is_present : t -> bool OBus_property.r +val lid_is_closed : t -> bool OBus_property.r +val on_low_battery : t -> bool OBus_property.r +val on_battery : t -> bool OBus_property.r +val can_hibernate : t -> bool OBus_property.r +val can_suspend : t -> bool OBus_property.r +val daemon_version : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/upower/uPower_device.ml b/bindings/upower/uPower_device.ml new file mode 100644 index 0000000..314e9cc --- /dev/null +++ b/bindings/upower/uPower_device.ml @@ -0,0 +1,177 @@ +(* + * uPower_device.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +include OBus_proxy.Private + +let general_error = "org.freedesktop.UPower.Device.GeneralError" + +type typ = + [ `Unknown + | `Line_power + | `Battery + | `Ups + | `Monitor + | `Mouse + | `Keyboard + | `Pda + | `Phone ] + +type state = + [ `Unknown + | `Charging + | `Discharging + | `Empty + | `Fully_charged + | `Pending_charge + | `Pending_discharge ] + +type technology = + [ `Unknown + | `Lithium_ion + | `Lithium_polymer + | `Lithium_iron_phosphate + | `Lead_acid + | `Nickel_cadmium + | `Nickel_metal_hydride ] + +open UPower_interfaces.Org_freedesktop_UPower_Device + +let refresh proxy = + OBus_method.call m_Refresh proxy () + +let changed proxy = + OBus_signal.make s_Changed proxy + +let get_history proxy ~typ ~timespan ~resolution = + let timespan = Int32.of_int timespan in + let resolution = Int32.of_int resolution in + let%lwt data = OBus_method.call m_GetHistory proxy (typ, timespan, resolution) in + let data = List.map (fun (x1, x2, x3) -> (Int32.to_int x1, x2, Int32.to_int x3)) data in + return data + +let get_statistics proxy ~typ = + OBus_method.call m_GetStatistics proxy typ + +let native_path proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_NativePath proxy + +let vendor proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Vendor proxy + +let model proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Model proxy + +let serial proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Serial proxy + +let update_time proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_UpdateTime proxy + +let typ proxy = + OBus_property.map_r + (function + | 0l -> `Unknown + | 1l -> `Line_power + | 2l -> `Battery + | 3l -> `Ups + | 4l -> `Monitor + | 5l -> `Mouse + | 6l -> `Keyboard + | 7l -> `Pda + | 8l -> `Phone + | n -> Printf.ksprintf failwith "invalid device type: %ld" n) + (OBus_property.make ~monitor:UPower_monitor.monitor p_Type proxy) + +let power_supply proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_PowerSupply proxy + +let has_history proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_HasHistory proxy + +let has_statistics proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_HasStatistics proxy + +let online proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Online proxy + +let energy proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Energy proxy + +let energy_empty proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyEmpty proxy + +let energy_full proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyFull proxy + +let energy_full_design proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyFullDesign proxy + +let energy_rate proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_EnergyRate proxy + +let voltage proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Voltage proxy + +let time_to_empty proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_TimeToEmpty proxy + +let time_to_full proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_TimeToFull proxy + +let percentage proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Percentage proxy + +let is_present proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_IsPresent proxy + +let state proxy = + OBus_property.map_r + (function + | 0l -> `Unknown + | 1l -> `Charging + | 2l -> `Discharging + | 3l -> `Empty + | 4l -> `Fully_charged + | 5l -> `Pending_charge + | 6l -> `Pending_discharge + | n -> Printf.ksprintf failwith "invalid device state: %ld" n) + (OBus_property.make ~monitor:UPower_monitor.monitor p_State proxy) + +let is_rechargeable proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_IsRechargeable proxy + +let capacity proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_Capacity proxy + +let technology proxy = + OBus_property.map_r + (function + | 0l -> `Unknown + | 1l -> `Lithium_ion + | 2l -> `Lithium_polymer + | 3l -> `Lithium_iron_phosphate + | 4l -> `Lead_acid + | 5l -> `Nickel_cadmium + | 6l -> `Nickel_metal_hydride + | n -> Printf.ksprintf failwith "invalid technolofy number: %ld" n) + (OBus_property.make ~monitor:UPower_monitor.monitor p_Technology proxy) + +let recall_notice proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_RecallNotice proxy + +let recall_vendor proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_RecallVendor proxy + +let recall_url proxy = + OBus_property.make ~monitor:UPower_monitor.monitor p_RecallUrl proxy + +let properties proxy = + OBus_property.group ~monitor:UPower_monitor.monitor proxy interface diff --git a/bindings/upower/uPower_device.mli b/bindings/upower/uPower_device.mli new file mode 100644 index 0000000..ccfbead --- /dev/null +++ b/bindings/upower/uPower_device.mli @@ -0,0 +1,90 @@ +(* + * uPower_device.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UPower device interface *) + +include OBus_proxy.Private + +(** {6 Types} *) + +(** Type of power source *) +type typ = + [ `Unknown + | `Line_power + | `Battery + | `Ups + | `Monitor + | `Mouse + | `Keyboard + | `Pda + | `Phone ] + +(** The battery power state *) +type state = + [ `Unknown + | `Charging + | `Discharging + | `Empty + | `Fully_charged + | `Pending_charge + | `Pending_discharge ] + +(** Technology used in the battery *) +type technology = + [ `Unknown + | `Lithium_ion + | `Lithium_polymer + | `Lithium_iron_phosphate + | `Lead_acid + | `Nickel_cadmium + | `Nickel_metal_hydride ] + +val general_error : OBus_error.name + +(** {6 Methods} *) + +val get_statistics : t -> typ : string -> (float * float) list Lwt.t +val get_history : t -> typ : string -> timespan : int -> resolution : int -> (int * float * int) list Lwt.t +val refresh : t -> unit Lwt.t + +(** {6 Signals} *) + +val changed : t -> unit OBus_signal.t + +(** {6 Properties} *) + +val recall_url : t -> string OBus_property.r +val recall_vendor : t -> string OBus_property.r +val recall_notice : t -> bool OBus_property.r +val technology : t -> technology OBus_property.r +val capacity : t -> float OBus_property.r +val is_rechargeable : t -> bool OBus_property.r +val state : t -> state OBus_property.r +val is_present : t -> bool OBus_property.r +val percentage : t -> float OBus_property.r +val time_to_full : t -> int64 OBus_property.r +val time_to_empty : t -> int64 OBus_property.r +val voltage : t -> float OBus_property.r +val energy_rate : t -> float OBus_property.r +val energy_full_design : t -> float OBus_property.r +val energy_full : t -> float OBus_property.r +val energy_empty : t -> float OBus_property.r +val energy : t -> float OBus_property.r +val online : t -> bool OBus_property.r +val has_statistics : t -> bool OBus_property.r +val has_history : t -> bool OBus_property.r +val power_supply : t -> bool OBus_property.r +val typ : t -> typ OBus_property.r +val update_time : t -> int64 OBus_property.r +val serial : t -> string OBus_property.r +val model : t -> string OBus_property.r +val vendor : t -> string OBus_property.r +val native_path : t -> string OBus_property.r + +val properties : t -> OBus_property.group diff --git a/bindings/upower/uPower_interfaces.obus b/bindings/upower/uPower_interfaces.obus new file mode 100644 index 0000000..224ade9 --- /dev/null +++ b/bindings/upower/uPower_interfaces.obus @@ -0,0 +1,90 @@ +(* + * uPower_interfaces.obus + * ---------------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +interface org.freedesktop.UPower { + method EnumerateDevices : () -> (devices : object_path array) + +(* Introspections files are wrong for this signals: + + signal DeviceAdded : (device : object_path) + signal DeviceRemoved : (device : object_path) + signal DeviceChanged : (device : object_path) *) + + signal DeviceAdded : (device : string) + signal DeviceRemoved : (device : string) + signal DeviceChanged : (device : string) + + signal Changed : () + signal Sleeping : () + signal Resuming : () + method AboutToSleep : () -> () + method Suspend : () -> () + method SuspendAllowed : () -> (allowed : boolean) + method Hibernate : () -> () + method HibernateAllowed : () -> (allowed : boolean) + property_r DaemonVersion : string + property_r CanSuspend : boolean + property_r CanHibernate : boolean + property_r OnBattery : boolean + property_r OnLowBattery : boolean + property_r LidIsClosed : boolean + property_r LidIsPresent : boolean +} + +interface org.freedesktop.UPower.Device { + method Refresh : () -> () + signal Changed : () + method GetHistory : (type : string, timespan : uint32, resolution : uint32) -> (data : (uint32 * double * uint32) array) + method GetStatistics : (type : string) -> (data : (double * double) array) + property_r NativePath : string + property_r Vendor : string + property_r Model : string + property_r Serial : string + property_r UpdateTime : uint64 + property_r Type : uint32 + property_r PowerSupply : boolean + property_r HasHistory : boolean + property_r HasStatistics : boolean + property_r Online : boolean + property_r Energy : double + property_r EnergyEmpty : double + property_r EnergyFull : double + property_r EnergyFullDesign : double + property_r EnergyRate : double + property_r Voltage : double + property_r TimeToEmpty : int64 + property_r TimeToFull : int64 + property_r Percentage : double + property_r IsPresent : boolean + property_r State : uint32 + property_r IsRechargeable : boolean + property_r Capacity : double + property_r Technology : uint32 + property_r RecallNotice : boolean + property_r RecallVendor : string + property_r RecallUrl : string +} + +interface org.freedesktop.UPower.QoS { + method SetMinimumLatency : (type : string, value : int32) -> () + method RequestLatency : (type : string, value : int32, persistent : boolean) -> (cookie : uint32) + method CancelRequest : (type : string, cookie : uint32) -> () + method GetLatency : (type : string) -> (value : int32) + signal LatencyChanged : (type : string, value : int32) + method GetLatencyRequests : () -> (requests : (uint32 * uint32 * uint32 * string * int64 * boolean * string * string * int32) array) + signal RequestsChanged : () +} + +interface org.freedesktop.UPower.Wakeups { + property_r HasCapability : boolean + method GetTotal : () -> (value : uint32) + signal TotalChanged : (value : uint32) + method GetData : () -> (data : (boolean * uint32 * double * string * string) array) + signal DataChanged : () +} diff --git a/bindings/upower/uPower_monitor.ml b/bindings/upower/uPower_monitor.ml new file mode 100644 index 0000000..3a36071 --- /dev/null +++ b/bindings/upower/uPower_monitor.ml @@ -0,0 +1,35 @@ +(* + * uPower_monitor.ml + * ----------------- + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt_react +open Lwt + +module String_map = Map.Make(String) + +let changed interface = + OBus_member.Signal.make + ~interface + ~member:"Changed" + ~args:OBus_value.arg0 + ~annotations:[] + +let monitor proxy interface switch = + let%lwt event = + OBus_signal.connect ~switch + (OBus_signal.with_context + (OBus_signal.make (changed interface) proxy)) + and context, dict = OBus_property.get_all_no_cache proxy interface in + return (S.hold + ~eq:(String_map.equal (=)) + (OBus_property.map_of_list context dict) + (E.map_s + (fun (context, ()) -> + let%lwt context, dict = OBus_property.get_all_no_cache proxy interface in + return (OBus_property.map_of_list context dict)) + event)) diff --git a/bindings/upower/uPower_monitor.mli b/bindings/upower/uPower_monitor.mli new file mode 100644 index 0000000..a8a7376 --- /dev/null +++ b/bindings/upower/uPower_monitor.mli @@ -0,0 +1,13 @@ +(* + * uPower_monitor.mli + * ------------------ + * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Properties monitoring *) + +val monitor : OBus_property.monitor + (** Monitor for properties of upower interfaces. *) diff --git a/bindings/upower/uPower_policy.ml b/bindings/upower/uPower_policy.ml new file mode 100644 index 0000000..2f376db --- /dev/null +++ b/bindings/upower/uPower_policy.ml @@ -0,0 +1,83 @@ +(* + * uPower_policy.ml + * ---------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +type cookie = int + +type latency = [ `Cpu_dma | `Network ] + +let string_of_latency = function + | `Cpu_dma -> "cpu_dma" + | `Network -> "network" + +let latency_of_string = function + | "cpu_dma" -> `Cpu_dma + | "network" -> `Network + | latency -> Printf.ksprintf failwith "unknown latency type (%S)" latency + +type latency_request = { + lr_cookie : cookie; + lr_uid : int; + lr_pid : int; + lr_exec : string; + lr_timespec : int64; + lr_persistent : bool; + lr_typ : latency; + lr_reserved : string; + lr_value : int; +} + +open UPower_interfaces.Org_freedesktop_UPower_QoS + +let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Policy"] + +let set_minimum_latency daemon ~latency ~value = + OBus_method.call m_SetMinimumLatency (proxy daemon) (string_of_latency latency, Int32.of_int value) + +let request_latency daemon ~latency ~value ~persistent = + let value = Int32.of_int value in + let%lwt cookie = OBus_method.call m_RequestLatency (proxy daemon) (string_of_latency latency, value, persistent) in + let cookie = Int32.to_int cookie in + return cookie + +let cancel_request daemon ~latency ~cookie = + let cookie = Int32.of_int cookie in + OBus_method.call m_CancelRequest (proxy daemon) (string_of_latency latency, cookie) + +let get_latency daemon ~latency = + let%lwt value = OBus_method.call m_GetLatency (proxy daemon) (string_of_latency latency) in + let value = Int32.to_int value in + return value + +let latency_changed daemon = + OBus_signal.map + (fun (latency, value) -> + (latency_of_string latency, Int32.to_int value)) + (OBus_signal.make s_LatencyChanged (proxy daemon)) + +let get_latency_requests daemon = + let%lwt requests = OBus_method.call m_GetLatencyRequests (proxy daemon) () in + return + (List.map + (fun (cookie, uid, pid, exec, timespec, persistent, typ, reserved, value) -> { + lr_cookie = Int32.to_int cookie; + lr_uid = Int32.to_int uid; + lr_pid = Int32.to_int pid; + lr_exec = exec; + lr_timespec = timespec; + lr_persistent = persistent; + lr_typ = latency_of_string typ; + lr_reserved = reserved; + lr_value = Int32.to_int value; + }) + requests) + +let requests_changed daemon = + OBus_signal.make s_RequestsChanged (proxy daemon) diff --git a/bindings/upower/uPower_policy.mli b/bindings/upower/uPower_policy.mli new file mode 100644 index 0000000..a993c00 --- /dev/null +++ b/bindings/upower/uPower_policy.mli @@ -0,0 +1,61 @@ +(* + * uPower_policy.mli + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** Quality of service policy *) + +(** {6 Types} *) + +type cookie + (** Type of request identifiers *) + +type latency = [ `Cpu_dma | `Network ] + (** Type of latency request *) + +type latency_request = { + lr_cookie : cookie; + (** The random cookie that identifies the request. *) + + lr_uid : int; + (** The user ID that issued the request. *) + + lr_pid : int; + (** The process ID of the application. *) + + lr_exec : string; + (** The executable that issued the request. *) + + lr_timespec : int64; + (** The number of seconds since the epoch. *) + + lr_persistent : bool; + (** If the request is persistent and outlives the connection lifetime. *) + + lr_typ : latency; + (** The type of the request.*) + + lr_reserved : string; + + lr_value : int; + (** The value, in microseconds or kilobits per second. *) +} + +(** {6 Methods} *) + +val get_latency_requests : UPower.t -> latency_request list Lwt.t +val get_latency : UPower.t -> latency : latency -> int Lwt.t + +val request_latency : UPower.t -> latency : latency -> value : int -> persistent : bool -> cookie Lwt.t +val cancel_request : UPower.t -> latency : latency -> cookie : cookie -> unit Lwt.t + +val set_minimum_latency : UPower.t -> latency : latency -> value : int -> unit Lwt.t + +(** {6 Signals} *) + +val requests_changed : UPower.t -> unit OBus_signal.t +val latency_changed : UPower.t -> (latency * int) OBus_signal.t diff --git a/bindings/upower/uPower_wakeups.ml b/bindings/upower/uPower_wakeups.ml new file mode 100644 index 0000000..eeeb2ca --- /dev/null +++ b/bindings/upower/uPower_wakeups.ml @@ -0,0 +1,53 @@ +(* + * uPower_wakeups.ml + * ----------------- + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +open Lwt + +type data = { + data_is_userspace : bool; + data_id : int; + data_value : float; + data_cmdline : string option; + data_details : string; +} + +open UPower_interfaces.Org_freedesktop_UPower_Wakeups + +let proxy daemon = OBus_proxy.make (UPower.to_peer daemon) ["org"; "freedesktop"; "UPower"; "Wakeups"] + +let has_capability daemon = + OBus_property.make p_HasCapability (proxy daemon) + +let get_total daemon = + let%lwt value = OBus_method.call m_GetTotal (proxy daemon) () in + let value = Int32.to_int value in + return value + +let total_changed daemon = + OBus_signal.map + (fun value -> + let value = Int32.to_int value in + value) + (OBus_signal.make s_TotalChanged (proxy daemon)) + +let get_data daemon = + let%lwt data = OBus_method.call m_GetData (proxy daemon) () in + return + (List.map + (fun (is_userspace, id, value, cmdline, details) -> { + data_is_userspace = is_userspace; + data_id = Int32.to_int id; + data_value = value; + data_cmdline = if cmdline = "" then None else Some cmdline; + data_details = details; + }) + data) + +let data_changed daemon = + OBus_signal.make s_DataChanged (proxy daemon) diff --git a/bindings/upower/uPower_wakeups.mli b/bindings/upower/uPower_wakeups.mli new file mode 100644 index 0000000..16db989 --- /dev/null +++ b/bindings/upower/uPower_wakeups.mli @@ -0,0 +1,47 @@ +(* + * uPower_wakeups.mli + * ------------------ + * Copyright : (c) 2010, Jeremie Dimino <jeremie@dimino.org> + * Licence : BSD3 + * + * This file is a part of obus, an ocaml implementation of D-Bus. + *) + +(** UPower wakeups interface *) + +(** {6 Types} *) + +(** The data of all the processes and drivers which contribute to the + wakeups on the system. *) +type data = { + data_is_userspace : bool; + (** If the wakeup is from userspace ? *) + + data_id : int; + (** The process ID of the application, or the IRQ for kernel + drivers. *) + + data_value : float; + (** The number of wakeups per second. *) + + data_cmdline : string option; + (** The command line for the application, or [None] for kernel + drivers. *) + + data_details : string; + (** The details about the wakeup. *) +} + +(** {6 Methods} *) + +val get_data : UPower.t -> data list Lwt.t +val get_total : UPower.t -> int Lwt.t + +(** {6 Signals} *) + +val data_changed : UPower.t -> unit OBus_signal.t +val total_changed : UPower.t -> int OBus_signal.t + +(** {6 Properties} *) + +val has_capability : UPower.t -> bool OBus_property.r |