2018-06-15

* Ajout de claim_interface et release_interface
* Ajout de num_configurations dans descriptor
* Ajout de unref_devices
* Ajout de bulk_transfer

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)

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

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_vendor =          getf desc GT.device_descriptor_idvendor           |> Unsigned.UInt16.to_int;
-      id_product = getf desc GT.device_descriptor_idproduct |> 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_manufacturer =     getf desc GT.device_descriptor_imanufacturer      |> Unsigned.UInt8.to_int;
-      i_product = getf desc GT.device_descriptor_iproduct |> 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

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

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}
 ]