diff --git a/lib/generator/g.ml b/lib/generator/g.ml index f52861c..2a8e612 100644 --- a/lib/generator/g.ml +++ b/lib/generator/g.ml @@ -15,6 +15,8 @@ module P(F:Cstubs.FOREIGN) = struct let open_device = foreign "libusb_open" (ptr U.device @-> ptr (ptr U.device_handle) @-> returning U.error) let close_device = foreign "libusb_close" (ptr U.device_handle @-> returning void) let get_device_descriptor = foreign "libusb_get_device_descriptor" (ptr U.device @-> ptr U.device_descriptor @-> returning U.error) + let claim_interface = foreign "libusb_claim_interface" (ptr U.device_handle @-> int @-> returning U.error) + let release_interface = foreign "libusb_release_interface" (ptr U.device_handle @-> int @-> returning U.error) let get_string_descriptor_ascii = foreign "libusb_get_string_descriptor_ascii" (ptr U.device_handle @-> uint8_t @-> ptr char @-> int @-> returning U.error) let control_transfer = foreign "libusb_control_transfer" (ptr U.device_handle @-> uint8_t @-> uint8_t @-> uint16_t @-> uint16_t @-> ptr char @-> uint16_t @-> uint @-> returning U.error) let bulk_transfer = foreign "libusb_bulk_transfer" (ptr U.device_handle @-> uint8_t @-> ptr char @-> int @-> ptr int @-> uint @-> returning U.error) diff --git a/lib/generator/stubs/t.ml b/lib/generator/stubs/t.ml index 53f253c..15ad279 100644 --- a/lib/generator/stubs/t.ml +++ b/lib/generator/stubs/t.ml @@ -31,6 +31,7 @@ type device_descriptor = { id_product: int; (** Product ID.*) i_manufacturer: int; (** Index of string descriptor describing manufacturer. *) i_product: int; (** Index of string descriptor describing product. *) + num_configurations: int; } module Types(T:Cstubs.Types.TYPE) = struct diff --git a/lib/libusb.ml b/lib/libusb.ml index 3be877a..e12f7e4 100644 --- a/lib/libusb.ml +++ b/lib/libusb.ml @@ -67,6 +67,8 @@ let get_device_list () = let unref_device d = L.unref_device d +let unref_devices = List.iter unref_device + type device_handle = GT.device_handle structure ptr let open_device ?(unref=true) d = @@ -79,6 +81,18 @@ let open_device ?(unref=true) d = | Number _ -> assert false | e -> Error e +let claim_interface dh i = + match L.claim_interface dh i with + | Number _ -> assert false + | Success -> Ok () + | e -> Error e + +let release_interface dh i = + match L.release_interface dh i with + | Number _ -> assert false + | Success -> Ok () + | e -> Error e + let close_device h = L.close_device h let get_device_descriptor d = @@ -86,10 +100,11 @@ let get_device_descriptor d = match L.get_device_descriptor d (addr desc) with | Success -> Ok { - id_vendor = getf desc GT.device_descriptor_idvendor |> Unsigned.UInt16.to_int; - id_product = getf desc GT.device_descriptor_idproduct |> Unsigned.UInt16.to_int; - i_manufacturer = getf desc GT.device_descriptor_imanufacturer |> Unsigned.UInt8.to_int; - i_product = getf desc GT.device_descriptor_iproduct |> Unsigned.UInt8.to_int; + id_vendor = getf desc GT.device_descriptor_idvendor |> Unsigned.UInt16.to_int; + id_product = getf desc GT.device_descriptor_idproduct |> Unsigned.UInt16.to_int; + i_manufacturer = getf desc GT.device_descriptor_imanufacturer |> Unsigned.UInt8.to_int; + i_product = getf desc GT.device_descriptor_iproduct |> Unsigned.UInt8.to_int; + num_configurations = getf desc GT.device_descriptor_bnumconfigurations |> Unsigned.UInt8.to_int; } | Number _ -> assert false | e -> Error e @@ -119,11 +134,13 @@ match get_device_descriptor d with let filter_devices f dl = let keep, unref = List.partition f dl in - List.iter unref_device unref; + unref_devices unref; keep -let control_transfer ~device_handle ~request_type ~request ~value ~index ~buffer ~timeout = +let control_transfer ~device_handle ~request_type ~request ~value ~index ~buffer ~timeout () = + let sz = Bigarray.Array1.dim buffer in + L.control_transfer device_handle (Unsigned.UInt8.of_int request_type) @@ -133,3 +150,25 @@ let control_transfer ~device_handle ~request_type ~request ~value ~index ~buffer (bigarray_start array1 buffer) (Unsigned.UInt16.of_int sz) (Unsigned.UInt.of_int timeout) + +(* + a bigarray, + a Ctypes.CArray.t value, + memory returned by malloc, + memoryreturned by Ctypes.allocate, +*) +let bulk_transfer ~device_handle ~endpoint ~buffer ~timeout () = + let length = Bigarray.Array1.dim buffer in + let transferred = allocate int 0 in + match + L.bulk_transfer + device_handle + (Unsigned.UInt8.of_int endpoint) + (bigarray_start array1 buffer) + length + transferred + (Unsigned.UInt.of_int timeout) + with + | Success -> Ok (!@ transferred) + | Number n -> assert false + | e -> Error e diff --git a/lib/libusb.mli b/lib/libusb.mli index 85a4ac1..1039643 100644 --- a/lib/libusb.mli +++ b/lib/libusb.mli @@ -51,6 +51,9 @@ val unref_device: device -> unit If the decrement operation causes the reference count to reach zero, the device shall be destroyed. *) +val unref_devices: device list -> unit +(** [unref_device == List.iter unref_device] *) + val is_vendor: int -> device -> bool (** [is_vendor vend d] checks if device [d] vendor id is [vend] *) @@ -84,6 +87,12 @@ val get_device_descriptor: device -> (device_descriptor, error) result val get_string_descriptor: device_handle -> int -> (string, error) result +val claim_interface: device_handle -> int -> (unit, error) result + +val release_interface: device_handle -> int -> (unit, error) result + (** {1 Transfers} *) -val control_transfer: device_handle:device_handle -> request_type:int -> request:int -> value:int -> index:int -> buffer:(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> timeout:int -> error +val control_transfer: device_handle:device_handle -> request_type:int -> request:int -> value:int -> index:int -> buffer:(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> timeout:int -> unit -> error + +val bulk_transfer: device_handle:device_handle -> endpoint:int -> buffer:(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> timeout:int -> unit -> (int, error) result diff --git a/libusb.opam b/libusb.opam index 37e2c4a..fc92c4d 100644 --- a/libusb.opam +++ b/libusb.opam @@ -11,7 +11,9 @@ build: [ ] license: "Not yet decided" -bug-reports: "dontuse@metalscan.fr" depends: [ "jbuilder" {build & >= "1.0+beta13"} + "ctypes" {build} + "configurator" {build} + "ocamlfind" {build} ]