diff --git a/.gitignore b/.gitignore index f345627..d63db74 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ -_build/ +_build +**/*.merlin +*.install /ocaml-usb-*.tar.gz -/setup.data -/setup.log -/setup.exe -/setup-dev.exe + + + + diff --git a/.merlin b/.merlin deleted file mode 100644 index 17a31a7..0000000 --- a/.merlin +++ /dev/null @@ -1,4 +0,0 @@ -B _build/src -S src -PKG lwt lwt.ppx -FLG -w +a-4-40..42-44-45-48 diff --git a/Makefile b/Makefile index 3ffbdc7..056adfb 100644 --- a/Makefile +++ b/Makefile @@ -1,59 +1,5 @@ -# Makefile -# -------- -# Copyright : (c) 2012, Jeremie Dimino -# Licence : BSD3 -# -# Generic Makefile for oasis project +all: + jbuilder build @install @runtest -# Set to setup.exe for the release -SETUP := setup-dev.exe - -# Default rule -default: build - -# Setup for the development version -setup-dev.exe: _oasis setup.ml - sed '/^#/D' setup.ml > setup_dev.ml - ocamlfind ocamlopt -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || \ - ocamlfind ocamlc -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || true - rm -f setup_dev.* - -# Setup for the release -setup.exe: setup.ml - ocamlopt.opt -o $@ $< || ocamlopt -o $@ $< || ocamlc -o $@ $< - rm -f setup.cmx setup.cmi setup.o setup.obj setup.cmo - -build: $(SETUP) setup.data - ./$(SETUP) -build $(BUILDFLAGS) - -doc: $(SETUP) setup.data build - ./$(SETUP) -doc $(DOCFLAGS) - -test: $(SETUP) setup.data build - ./$(SETUP) -test $(TESTFLAGS) - -all: $(SETUP) - ./$(SETUP) -all $(ALLFLAGS) - -install: $(SETUP) setup.data - ./$(SETUP) -install $(INSTALLFLAGS) - -uninstall: $(SETUP) setup.data - ./$(SETUP) -uninstall $(UNINSTALLFLAGS) - -reinstall: $(SETUP) setup.data - ./$(SETUP) -reinstall $(REINSTALLFLAGS) - -clean: $(SETUP) - ./$(SETUP) -clean $(CLEANFLAGS) - -distclean: $(SETUP) - ./$(SETUP) -distclean $(DISTCLEANFLAGS) - -configure: $(SETUP) - ./$(SETUP) -configure $(CONFIGUREFLAGS) - -setup.data: $(SETUP) - ./$(SETUP) -configure $(CONFIGUREFLAGS) - -.PHONY: default build doc test all install uninstall reinstall clean distclean configure +clean: + rm -rf _build diff --git a/_oasis b/_oasis deleted file mode 100644 index ca157ca..0000000 --- a/_oasis +++ /dev/null @@ -1,37 +0,0 @@ -OASISFormat: 0.3 -Name: ocaml-usb -Version: 1.3.0 -LicenseFile: COPYING -License: BSD-3-clause -Authors: Jérémie Dimino -Homepage: http://ocaml-usb.forge.ocamlcore.org/ -BuildTools: ocamlbuild -Plugins: DevFiles (0.3), META (0.3) -XDevFilesEnableMakefile: false -Synopsis: Bindings for libusb-1.0 -Description: - OCaml-USB is a binding to libusb-1.0. It uses Lwt to make it easy - to use asynchronous IO features of libusb-1.0. - -Library "usb" - FindlibName: usb - Path: src - Modules: USB - BuildDepends: lwt.unix, lwt.ppx - XMETADescription: Bindings for libusb-1.0 - XMETARequires: lwt.unix - CSources: usb_stubs.c - -Document "ocaml-usb-api" - Title: API reference for ocaml-usb - Type: ocamlbuild (0.3) - Install: true - InstallDir: $htmldir/api - BuildTools: ocamldoc - XOCamlbuildPath: ./ - XOCamlbuildLibraries: usb - -SourceRepository head - Type: git - Location: https://github.com/diml/ocaml-usb.git - Browser: https://github.com/diml/ocaml-usb diff --git a/_tags b/_tags deleted file mode 100644 index 369b744..0000000 --- a/_tags +++ /dev/null @@ -1,4 +0,0 @@ -: use_libusb - -# OASIS_START -# OASIS_STOP diff --git a/configure b/configure deleted file mode 100755 index 3234be2..0000000 --- a/configure +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/sh - -# OASIS_START -make configure CONFIGUREFLAGS="$*" -# OASIS_STOP diff --git a/dist b/dist deleted file mode 100755 index ae5efa6..0000000 --- a/dist +++ /dev/null @@ -1,38 +0,0 @@ -#!/bin/bash -# -# dist -# ---- -# Copyright : (c) 2012, Jeremie Dimino -# Licence : BSD3 -# -# Script to build the release - -set -e - -# Extract project parameters from _oasis -NAME=`oasis query Name 2> /dev/null` -VERSION=`oasis query Version 2> /dev/null` -PREFIX=$NAME-$VERSION -ARCHIVE=$(pwd)/$PREFIX.tar.gz - -# Temporary directory -DIR=$(mktemp -t -d dist.XXXXXXXXXX) -trap "rm -rf $DIR" EXIT - -# Copy files into the temporary directory -git archive --format=tar --prefix $NAME-$VERSION/ HEAD | tar xf - -C $DIR - -cd $DIR/$PREFIX - -# Generate files -oasis setup - -# Set release mode in the Makefile -sed -i 's/^SETUP := setup-dev.exe.*/SETUP := setup.exe/' Makefile - -# Remove this script -rm -f dist - -# Create the archive -cd .. -tar czf $ARCHIVE $PREFIX diff --git a/examples/Makefile b/examples/Makefile deleted file mode 100644 index 5a34793..0000000 --- a/examples/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -# Makefile -# -------- -# Copyright : (c) 2009, Jeremie Dimino -# Licence : BSD3 -# -# This file is a part of ocaml-usb. - -# Tools -OCAMLFIND := ocamlfind -OCAMLBUILD := ocamlbuild - -# Use classic-display when compiling under a terminal which does not -# support ANSI sequence: -ifeq ($(TERM),dumb) -OCAMLBUILD += -classic-display -endif - -all: best - -best: - $(OCAMLBUILD) best - -byte: - $(OCAMLBUILD) byte - -native: - $(OCAMLBUILD) native - -clean: - $(OCAMLBUILD) -clean - -.PHONY: best all byte native clean diff --git a/examples/_tags b/examples/_tags deleted file mode 100644 index 6e7feef..0000000 --- a/examples/_tags +++ /dev/null @@ -1,3 +0,0 @@ -# -*- conf -*- - -<*>: thread, pkg_usb diff --git a/examples/jbuild b/examples/jbuild new file mode 100644 index 0000000..d1ee7dc --- /dev/null +++ b/examples/jbuild @@ -0,0 +1,4 @@ +(executable + ((name list_devices) + (public_name ocaml-usb-list-devices) + (libraries (usb)))) diff --git a/examples/list_devices.ml b/examples/list_devices.ml index 68a3d46..abb979c 100644 --- a/examples/list_devices.ml +++ b/examples/list_devices.ml @@ -7,10 +7,8 @@ * This file is a part of ocaml-usb. *) -open Lwt - -let _ = +let () = List.iter (fun dev -> - Printf.printf "Bus %03d Device %03d\n" (USB.get_bus_number dev) (USB.get_device_address dev)) - (USB.get_device_list ()) + Printf.printf "Bus %03d Device %03d\n" (Usb.get_bus_number dev) (Usb.get_device_address dev)) + (Usb.get_device_list ()) diff --git a/examples/myocamlbuild.ml b/examples/myocamlbuild.ml deleted file mode 100644 index ae525fb..0000000 --- a/examples/myocamlbuild.ml +++ /dev/null @@ -1,111 +0,0 @@ -(* - * myocamlbuild.ml - * --------------- - * Copyright : (c) 2009, Jeremie Dimino - * Licence : BSD3 - * - * This file is a part of ocaml-usb. - *) - -open Printf -open Ocamlbuild_plugin - -(* +-----------------------------------------------------------------+ - | Configuration | - +-----------------------------------------------------------------+ *) - -let try_exec command = - try - let _ = run_and_read command in - true - with _ -> - false - -let () = - if not (try_exec "ocamlfind printconf") then begin - prerr_endline "ocamlfind is not available, please install it"; - exit 1 - end - -let have_native = try_exec "ocamlfind ocamlopt -version" - -(* +-----------------------------------------------------------------+ - | Ocamlfind | - +-----------------------------------------------------------------+ *) - -(* Packages we want to use: *) -let packages = [ - "lwt"; - "lwt.preemptive"; - "lwt.extra"; - "lwt.ssl"; - "lwt.glib"; - "lwt.text"; - "lwt.unix"; - "lwt.ppx"; - "usb"; -] - -(* +-----------------------------------------------------------------+ - | Utils | - +-----------------------------------------------------------------+ *) - -(* Given the tag [tag] add the command line options [f] to all stages - of compilatiopn but linking *) -let flag_all_stages_except_link tag f = - flag ["ocaml"; "compile"; tag] f; - flag ["ocaml"; "ocamldep"; tag] f; - flag ["ocaml"; "doc"; tag] f - -(* Same as [flag_all_stages_except_link] but also flag the linking - stage *) -let flag_all_stages tag f = - flag_all_stages_except_link tag f; - flag ["ocaml"; "link"; tag] f - -let _ = - dispatch begin function - | Before_options -> - - (* override default commands by ocamlfind ones *) - let ocamlfind x = S[A"ocamlfind"; A x] in - Options.ocamlc := ocamlfind "ocamlc"; - Options.ocamlopt := ocamlfind "ocamlopt"; - Options.ocamldep := ocamlfind "ocamldep"; - Options.ocamldoc := ocamlfind "ocamldoc" - - | After_rules -> - - (* +---------------------------------------------------------+ - | Virtual targets | - +---------------------------------------------------------+ *) - - let examples = ["list_devices"] in - - let byte = List.map (sprintf "%s.byte") examples - and native = List.map (sprintf "%s.native") examples in - - let virtual_rule name deps = - rule name ~stamp:name ~deps (fun _ _ -> Nop) - in - - virtual_rule "best" & if have_native then native else byte; - virtual_rule "byte" & byte; - virtual_rule "native" & native; - - (* +---------------------------------------------------------+ - | Ocamlfind stuff | - +---------------------------------------------------------+ *) - - (* When one link an OCaml binary, one should use -linkpkg *) - flag ["ocaml"; "link"; "program"] & A"-linkpkg"; - - (* For each ocamlfind package one inject the -package option - when compiling, computing dependencies, generating - documentation and linking. *) - List.iter - (fun package -> flag_all_stages ("pkg_" ^ package) (S[A"-package"; A package])) - packages; - - | _ -> () - end diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index b45e568..0000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,48 +0,0 @@ -(* - * myocamlbuild.ml - * --------------- - * Copyright : (c) 2010, Jeremie Dimino - * Licence : BSD3 - * - * This file is a part of ocaml-usb. - *) - -(* OASIS_START *) -(* OASIS_STOP *) - -open Ocamlbuild_plugin - -let pkg_config flags package = - with_temp_file "lwt" "pkg-config" - (fun tmp -> - Command.execute ~quiet:true & Cmd(S[A "pkg-config"; A("--" ^ flags); A package; Sh ">"; A tmp]); - List.map (fun arg -> A arg) (string_list_of_file tmp)) - -let define_c_library ~name ~c_name = - let tag = Printf.sprintf "use_%s" name in - - (* Get flags for using pkg-config: *) - let opt = pkg_config "cflags" c_name and lib = pkg_config "libs" c_name in - - (* Add flags for linking with the C library: *) - flag ["ocamlmklib"; "c"; tag] & S lib; - - (* C stubs using the C library must be compiled with the library - specifics flags: *) - flag ["c"; "compile"; tag] & S(List.map (fun arg -> S[A"-ccopt"; arg]) opt); - - (* OCaml libraries must depends on the C library: *) - flag ["link"; "ocaml"; tag] & S(List.map (fun arg -> S[A"-cclib"; arg]) lib) - -let () = - dispatch - (fun hook -> - dispatch_default hook; - match hook with - | Before_options -> - Options.make_links := false - | After_rules -> - define_c_library ~name:"libusb" ~c_name:"libusb-1.0"; - flag ["c"; "compile"; "use_libusb"] & S[A"-package"; A"lwt"] - | _ -> - ()) diff --git a/setup.ml b/setup.ml deleted file mode 100644 index 37e9a1a..0000000 --- a/setup.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* - * setup.ml - * -------- - * Copyright : (c) 2011, Jeremie Dimino - * Licence : BSD3 - *) - -(* OASIS_START *) -#use "topfind";; -#require "oasis.dynrun";; -open OASISDynRun;; -(* OASIS_STOP *) - -let () = setup ();; diff --git a/src/config/discover.ml b/src/config/discover.ml new file mode 100644 index 0000000..263fd06 --- /dev/null +++ b/src/config/discover.ml @@ -0,0 +1,23 @@ +open Base +open Stdio +module C = Configurator + +let write_sexp fn sexp = + Out_channel.write_all fn ~data:(Sexp.to_string sexp) + +let () = + C.main ~name:"libusb" (fun c -> + let default : C.Pkg_config.package_conf = + { libs = [] + ; cflags = [] + } + in + let conf = + match C.Pkg_config.get c with + | None -> default + | Some pc -> + Option.value (C.Pkg_config.query pc ~package:"libusb-1.0") ~default + in + + write_sexp "c_flags.sexp" (sexp_of_list sexp_of_string conf.cflags); + write_sexp "c_library_flags.sexp" (sexp_of_list sexp_of_string conf.libs)) diff --git a/src/config/jbuild b/src/config/jbuild new file mode 100644 index 0000000..55e8c70 --- /dev/null +++ b/src/config/jbuild @@ -0,0 +1,3 @@ +(executable + ((name discover) + (libraries (base stdio configurator)))) \ No newline at end of file diff --git a/src/jbuild b/src/jbuild new file mode 100644 index 0000000..72770a0 --- /dev/null +++ b/src/jbuild @@ -0,0 +1,14 @@ +(library + ((name usb) + (public_name usb) + (libraries (lwt.unix)) + (preprocess (pps (ppx_sexp_conv))) + (c_names (usb_stubs)) + (c_flags (:include c_flags.sexp)) + (c_library_flags (:include c_library_flags.sexp)))) + +(rule + ((targets (c_flags.sexp + c_library_flags.sexp)) + (deps (config/discover.exe)) + (action (run ${<} -ocamlc ${OCAMLC})))) diff --git a/src/USB.ml b/src/usb.ml similarity index 81% rename from src/USB.ml rename to src/usb.ml index 89a8f2a..726169a 100644 --- a/src/USB.ml +++ b/src/usb.ml @@ -7,6 +7,8 @@ * This file is a part of ocaml-usb. *) +open Sexplib.Std +open Lwt.Infix open Lwt_unix (* +-----------------------------------------------------------------+ @@ -361,92 +363,177 @@ let open_device_with ~vendor_id ~product_id = | USB descriptors | +-----------------------------------------------------------------+ *) -module Class = -struct - type t = int - - let per_interface = 0 - let audio = 1 - let communication = 2 - let hid = 3 - let physical = 5 - let printer = 7 - let ptp = 6 - let image = 6 - let mass_storage = 8 - let hub = 9 - let data = 10 - let smart_card = 0x0b - let content_security = 0x0d - let video = 0x0e - let personal_healthcare = 0x0f - let diagnostic_device = 0xdc - let wireless = 0xe0 - let application = 0xfe - let vendor_specific = 0xff - - let to_string n = - try - List.assoc n [(per_interface, "per interface"); - (audio, "audio"); - (communication, "communication"); - (hid, "HID"); - (physical, "physical"); - (printer, "printer"); - (image, "image"); - (mass_storage, "mass storage"); - (hub, "HUB"); - (data, "data"); - (smart_card, "smart card"); - (content_security, "content security"); - (video, "video"); - (personal_healthcare, "personal healthcare"); - (diagnostic_device, "diagnostic device"); - (wireless, "wireless"); - (application, "application"); - (vendor_specific, "vendor specific")] - with Not_found -> - Printf.sprintf "0x%x02x" n +module Class = struct + type t = + | Per_interface + | Audio + | Communication + | Hid + | Physical + | Printer + | Image + | Mass_storage + | Hub + | Data + | Smart_card + | Content_security + | Video + | Personal_healthcare + | Audio_video_device + | Billboard_device_class + | Usb_type_c_bridge_class + | Diagnostic_device + | Wireless_controler + | Misc + | Application_specific + | Vendor_specific + [@@deriving sexp] + + let to_int = function + | Per_interface -> 0x00 + | Audio -> 0x01 + | Communication -> 0x02 + | Hid -> 0x03 + | Physical -> 0x05 + | Printer -> 0x06 + | Image -> 0x07 + | Mass_storage -> 0x08 + | Hub -> 0x09 + | Data -> 0x0a + | Smart_card -> 0x0b + | Content_security -> 0x0d + | Video -> 0x0e + | Personal_healthcare -> 0x0f + | Audio_video_device -> 0x10 + | Billboard_device_class -> 0x11 + | Usb_type_c_bridge_class -> 0x12 + | Diagnostic_device -> 0xdc + | Wireless_controler -> 0xe0 + | Misc -> 0xef + | Application_specific -> 0xfe + | Vendor_specific -> 0xff + + let of_int = function + | 0x00 -> Per_interface + | 0x01 -> Audio + | 0x02 -> Communication + | 0x03 -> Hid + | 0x05 -> Physical + | 0x06 -> Image + | 0x07 -> Printer + | 0x08 -> Mass_storage + | 0x09 -> Hub + | 0x0a -> Data + | 0x0b -> Smart_card + | 0x0d -> Content_security + | 0x0e -> Video + | 0x0f -> Personal_healthcare + | 0x10 -> Audio_video_device + | 0x11 -> Billboard_device_class + | 0x12 -> Usb_type_c_bridge_class + | 0xdc -> Diagnostic_device + | 0xe0 -> Wireless_controler + | 0xef -> Misc + | 0xfe -> Application_specific + | 0xff -> Vendor_specific + | _ -> invalid_arg "Class.of_int" end type device_descriptor = { - dd_usb : int; - dd_device_class : Class.t; - dd_device_sub_class : int; - dd_device_protocol : int; - dd_max_packet_size : int; - dd_vendor_id : int; - dd_product_id : int; - dd_device : int; - dd_index_manufacturer : int; - dd_index_product : int; - dd_index_serial_number : int; - dd_configurations : int; -} -type endpoint_descriptor = { - ed_endpoint_address : int; - ed_attributes : int; - ed_max_packet_size : int; - ed_interval : int; - ed_refresh : int; - ed_synch_address : int; -} + usb : int; + device_class : Class.t; + device_sub_class : int; + device_protocol : int; + max_packet_size : int; + vendor_id : int; + product_id : int; + device : int; + index_manufacturer : int; + index_product : int; + index_serial_number : int; + configurations : int; +} [@@deriving sexp] + +module Endpoint = struct + type direction = Input | Output + let direction_of_int i = if i <= 1 lsl 7 then Input else Output + + type transfer = + | Control + | Bulk + | Interrupt + | Isochronous of synchronisation * usage + and synchronisation = No_sync | Async | Adaptative | Sync + and usage = Data | Feedback | Explicit | Reserved + [@@deriving sexp] + + let transfer_of_int i = + match i land 0x03 with + | 0 -> Control + | 2 -> Bulk + | 3 -> Interrupt + | 1 -> begin + let sync = match (i lsr 2) land 0x03 with + | 0 -> No_sync + | 1 -> Async + | 2 -> Adaptative + | 3 -> Sync + | _ -> assert false in + let usage = match (1 lsr 4) land 0x03 with + | 0 -> Data + | 1 -> Feedback + | 2 -> Explicit + | 3 -> Reserved + | _ -> assert false in + Isochronous (sync, usage) + end + | _ -> assert false + + type raw_descriptor = { + endpoint_address : int; + attributes : int; + max_packet_size : int; + interval : int; + refresh : int; + sync_address : int; + } [@@deriving sexp] + + type descriptor = { + address : int ; + transfer : transfer ; + max_packet_size : int ; + interval : int ; + refresh : int ; + sync_address : int ; + } [@@deriving sexp] + + let descriptor_of_raw r = { + address = r.endpoint_address land 0x07 ; + transfer = transfer_of_int r.attributes ; + max_packet_size = r.max_packet_size ; + interval = r.interval ; + refresh = r.refresh ; + sync_address = r.sync_address ; + } +end + type interface_descriptor = { - id_interface : int; - id_alternate_setting : int; - id_interface_class : Class.t; - id_interface_sub_class : int; - id_interface_protocol : int; - id_index_interface : int; - id_endpoints : endpoint_descriptor array; -} + interface : int; + alternate_setting : int; + interface_class : Class.t; + interface_sub_class : int; + interface_protocol : int; + index_interface : int; + endpoints : Endpoint.raw_descriptor array; +} [@@deriving sexp] + type config_descriptor = { - cd_configuration_value : int; - cd_index_configuration : int; - cd_attributes : int; - cd_max_power : int; - cd_interfaces : interface_descriptor array array; -} + configuration_value : int; + index_configuration : int; + attributes : int; + max_power : int; + interfaces : interface_descriptor array array; +} [@@deriving sexp] external get_device_descriptor : device -> device_descriptor = "ml_usb_get_device_descriptor" external get_active_config_descriptor : device -> config_descriptor = "ml_usb_get_active_config_descriptor" @@ -551,34 +638,34 @@ end | Helpers | +-----------------------------------------------------------------+ *) -let get_string_descriptor handle ?timeout ?lang_id ~index = +let get_string_descriptor ?timeout ?lang_id handle index = let data = Bytes.create 255 in - let%lwt lang_id = match lang_id with + begin match lang_id with | Some lang_id -> Lwt.return lang_id | None -> (* Guess the default language id *) - let%lwt n = control_recv - ~handle - ~endpoint:0 - ?timeout - ~request:Request.get_descriptor - ~value:(DT.string lsl 8) - ~index:0 - data 0 (String.length data) in + control_recv + ~handle + ~endpoint:0 + ?timeout + ~request:Request.get_descriptor + ~value:(DT.string lsl 8) + ~index:0 + data 0 (String.length data) >>= fun n -> if n < 4 then Lwt.fail (Failure "USB.get_string_descriptor: cannot retreive default lang id") else Lwt.return (Char.code data.[2] lor (Char.code data.[3] lsl 8)) - in - let%lwt n = control_recv - ~handle - ~endpoint:0 - ?timeout - ~request:Request.get_descriptor - ~value:(DT.string lsl 8 lor index) - ~index:lang_id - data 0 (String.length data) in + end >>= fun lang_id -> + control_recv + ~handle + ~endpoint:0 + ?timeout + ~request:Request.get_descriptor + ~value:(DT.string lsl 8 lor index) + ~index:lang_id + data 0 (String.length data) >>= fun n -> let len = Char.code data.[0] in if Char.code data.[1] <> DT.string || len > n then Lwt.fail (Failure "USB.get_string_descriptor: invalid control packet") diff --git a/src/USB.mli b/src/usb.mli similarity index 81% rename from src/USB.mli rename to src/usb.mli index 6559857..07a39b1 100644 --- a/src/USB.mli +++ b/src/usb.mli @@ -193,152 +193,175 @@ val reset_device : handle -> unit Lwt.t (** Device class codes *) module Class : sig - type t = int - - val per_interface : t - val audio : t - val communication : t - val hid : t - val physical : t - val printer : t - val image : t - val mass_storage : t - val hub : t - val data : t - val smart_card : t - val content_security : t - val video : t - val personal_healthcare : t - val diagnostic_device : t - val wireless : t - val application : t - val vendor_specific : t - - val ptp : t - (** Legacy name, same as {!image}. *) - - val to_string : t -> string - (** Returns a string representation of a device class code *) + type t = + | Per_interface + | Audio + | Communication + | Hid + | Physical + | Printer + | Image + | Mass_storage + | Hub + | Data + | Smart_card + | Content_security + | Video + | Personal_healthcare + | Audio_video_device + | Billboard_device_class + | Usb_type_c_bridge_class + | Diagnostic_device + | Wireless_controler + | Misc + | Application_specific + | Vendor_specific + [@@deriving sexp] + + val to_int : t -> int + val of_int : int -> t end type device_descriptor = { - dd_usb : int; + usb : int; (** USB specification release number in binary-coded decimal. A value of 0x0200 indicates USB 2.0, 0x0110 indicates USB 1.1, etc. *) - dd_device_class : Class.t; + device_class : Class.t; (** USB-IF class code for the device. *) - dd_device_sub_class : int; + device_sub_class : int; (** USB-IF subclass code for the device, qualified by the - [dd_device_class] value. *) + [device_class] value. *) - dd_device_protocol : int; + device_protocol : int; (** USB-IF protocol code for the device, qualified by the - [dd_device_class] and [dd_device_subclass] values. *) + [device_class] and [device_subclass] values. *) - dd_max_packet_size : int; + max_packet_size : int; (** Maximum packet size for endpoint 0. *) - dd_vendor_id : int; + vendor_id : int; (** USB-IF vendor ID. *) - dd_product_id : int; + product_id : int; (** USB-IF product ID. *) - dd_device : int; + device : int; (** Device release number in binary-coded decimal. *) - dd_index_manufacturer : int; + index_manufacturer : int; (** Index of string descriptor describing manufacturer. *) - dd_index_product : int; + index_product : int; (** Index of string descriptor describing product. *) - dd_index_serial_number : int; + index_serial_number : int; (** Index of string descriptor containing device serial number. *) - dd_configurations : int; + configurations : int; (** Number of possible configurations. *) -} +} [@@deriving sexp] val get_device_descriptor : device -> device_descriptor (** Get the USB device descriptor for a given device. *) -type endpoint_descriptor = { - ed_endpoint_address : int; - (** The address of the endpoint described by this descriptor. *) - - ed_attributes : int; - (** Attributes which apply to the endpoint when it is configured - using the {!cd_configuration_value}. *) - - ed_max_packet_size : int; - (** Maximum packet size this endpoint is capable of - sending/receiving. *) - - ed_interval : int; - (** Interval for polling endpoint for data transfers. *) - - ed_refresh : int; - (** For audio devices only: the rate at which synchronization - feedback is provided. *) - - ed_synch_address : int; - (** For audio devices only: the address if the synch endpoint. *) -} +module Endpoint : sig + type raw_descriptor = { + endpoint_address : int; + (** The address of the endpoint described by this descriptor. *) + + attributes : int; + (** Attributes which apply to the endpoint when it is configured + using the {!cd_configuration_value}. *) + + max_packet_size : int; + (** Maximum packet size this endpoint is capable of + sending/receiving. *) + + interval : int; + (** Interval for polling endpoint for data transfers. *) + + refresh : int; + (** For audio devices only: the rate at which synchronization + feedback is provided. *) + + sync_address : int; + (** For audio devices only: the address if the synch endpoint. *) + } [@@deriving sexp] + + type direction = Input | Output + type transfer = + | Control + | Bulk + | Interrupt + | Isochronous of synchronisation * usage + and synchronisation = No_sync | Async | Adaptative | Sync + and usage = Data | Feedback | Explicit | Reserved + + type descriptor = { + address : int ; + transfer: transfer ; + max_packet_size : int ; + interval : int ; + refresh : int ; + sync_address : int ; + } [@@deriving sexp] + + val descriptor_of_raw : raw_descriptor -> descriptor +end type interface_descriptor = { - id_interface : int; + interface : int; (** Number of this interface. *) - id_alternate_setting : int; + alternate_setting : int; (** Value used to select this alternate setting for this interface. *) - id_interface_class : Class.t; + interface_class : Class.t; (** USB-IF class code for this interface. *) - id_interface_sub_class : int; + interface_sub_class : int; (** USB-IF subclass code for this interface, qualified by the - [id_interface_class] value. *) + [interface_class] value. *) - id_interface_protocol : int; + interface_protocol : int; (** USB-IF protocol code for this interface, qualified by the - [id_interface_class] and [id_interface_sub_class] values. *) + [interface_class] and [interface_sub_class] values. *) - id_index_interface : int; + index_interface : int; (** Index of string descriptor describing this interface. *) - id_endpoints : endpoint_descriptor array; + endpoints : Endpoint.raw_descriptor array; (** Array of endpoint descriptors. *) -} +} [@@deriving sexp] type config_descriptor = { - cd_configuration_value : int; + configuration_value : int; (** Identifier value for this configuration *) - cd_index_configuration : int; + index_configuration : int; (** Index of string descriptor describing this configuration. *) - cd_attributes : int; + attributes : int; (** A bitmask, representing configuration characteristics. *) - cd_max_power : int; + max_power : int; (** Maximum power consumption of the USB device from this bus in this configuration when the device is fully opreation. Expressed in units of 2 mA. *) - cd_interfaces : interface_descriptor array array; + interfaces : interface_descriptor array array; (** Array of interfaces supported by this configuration. - [cd_interface.(iface).(altsetting)] designate the interface + [interface.(iface).(altsetting)] designate the interface descriptor for interface [iface] with alternate setting [altsetting]. *) -} +} [@@deriving sexp] val get_active_config_descriptor : device -> config_descriptor (** Get the USB configuration descriptor for the currently active @@ -349,23 +372,9 @@ val get_config_descriptor : device -> int -> config_descriptor val get_config_descriptor_by_value : device -> int -> config_descriptor (** Get a USB configuration descriptor with a specific - [cd_configuration_value]. *) - -(** Descriptor types *) -module DT : sig - type t = int - val device : t - val config : t - val string : t - val interface : t - val endpoint : t - val hid : t - val report : t - val physical : t - val hub : t -end + [configuration_value]. *) -val get_string_descriptor : handle -> ?timeout : float -> ?lang_id : int -> index : int -> string Lwt.t +val get_string_descriptor : ?timeout : float -> ?lang_id : int -> handle -> int -> string Lwt.t (** Retrieve a string descriptor from a device. *) (** {6 IOs} *) diff --git a/usb.opam b/usb.opam new file mode 100644 index 0000000..e4eeacf --- /dev/null +++ b/usb.opam @@ -0,0 +1,18 @@ +opam-version: "1.2" +name: "usb" +version: "1.4.0" +authors: "Jeremie Dimino " +maintainer: "Vincent Bernardoff " +homepage: "https://github.com/vbmithr/ocaml-usb" +bug-reports: "https://github.com/vbmithr/ocaml-usb/issues" +dev-repo: "git://github.com/vbmithr/ocaml-usb" + +available: [ + ocaml-version >= "4.02.0" +] + +build: [ "jbuilder" "build" "-j" jobs "-p" name "@install" ] +depends: [ + "jbuilder" {build & >= "1.0+beta13"} + "lwt" {>= "2.0.0"} +]