pax_global_header00006660000000000000000000000064135323035730014516gustar00rootroot0000000000000052 comment=70ca17e3f0bd72a34f17edd6cff3c478ddf03c1a ocaml-usb-1.3.1/000077500000000000000000000000001353230357300134025ustar00rootroot00000000000000ocaml-usb-1.3.1/.gitignore000066400000000000000000000001151353230357300153670ustar00rootroot00000000000000_build/ /ocaml-usb-*.tar.gz /setup.data /setup.log /setup.exe /setup-dev.exe ocaml-usb-1.3.1/.merlin000066400000000000000000000000771353230357300146750ustar00rootroot00000000000000B _build/src S src PKG lwt lwt.ppx FLG -w +a-4-40..42-44-45-48 ocaml-usb-1.3.1/CHANGES.md000066400000000000000000000011021353230357300147660ustar00rootroot000000000000001.3.1 (2019-08-28) ------------------ * feat: add ppx support (#2) * fix: make control transfer work (#3) * fix: proper cleanup (#1) * build: fix compilation issue with safe-string (#5) * build: remove camlp4 from the dependencies 1.3.0 (2012-07-30) ------------------ * fix an initialization bug * fix build of stubs of kfreebsd * add more device classes * update oasis files 1.2.0 (2011-05-18) ------------------ * upgrade for lwt-2.3.0 1.1.0 (2010-12-15) ------------------ * use oasis * upgrade for lwt-2.2.0 1.0.0 (2010-04-17) ------------------ * Initial release ocaml-usb-1.3.1/LICENSE000066400000000000000000000027561353230357300144210ustar00rootroot00000000000000Copyright (c) 2009, Jeremie Dimino All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jeremie Dimino nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ocaml-usb-1.3.1/Makefile000066400000000000000000000030261353230357300150430ustar00rootroot00000000000000# Makefile # -------- # Copyright : (c) 2012, Jeremie Dimino # Licence : BSD3 # # Generic Makefile for oasis project # 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 ./config_pkg || true 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 ./config_pkg || true 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) ./config_pkg --distclean || true ./$(SETUP) -distclean $(DISTCLEANFLAGS) rm -f setup*.exe configure: $(SETUP) ./$(SETUP) -configure $(CONFIGUREFLAGS) setup.data: $(SETUP) ./$(SETUP) -configure $(CONFIGUREFLAGS) .PHONY: default build doc test all install uninstall reinstall clean distclean configure ocaml-usb-1.3.1/README.md000066400000000000000000000014441353230357300146640ustar00rootroot00000000000000OCaml-USB ========= 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. Dependencies ------------ * [OCaml](http://ocaml.org/) (>= 4.02.0) * [findlib](http://projects.camlcity.org/projects/findlib.html) * [lwt](http://ocsigen.org/lwt/) (>= 2.4.7) * [libusb-1.0](http://www.libusb.org/) For building the development version, you also need to install [oasis](http://oasis.forge.ocamlcore.org/) (>= 0.3.0) Installation ------------ To build and install ocaml-usb: $ ./configure $ make $ make install ### Documentation _(optional)_ To build the documentation: $ make doc It will then be installed by `make install`. ### Tests _(optionnal)_ To build and execute tests: $ ./configure --enable-tests $ make test ocaml-usb-1.3.1/_oasis000066400000000000000000000017311353230357300146040ustar00rootroot00000000000000OASISFormat: 0.3 Name: ocaml-usb Version: 1.3.0 LicenseFile: COPYING License: BSD-3-clause Authors: Jérémie Dimino Homepage: https://github.com/letoh/ocaml-usb 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 CCopt: -I"`ocamlfind query lwt`/unix" 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/letoh/ocaml-usb.git Browser: https://github.com/letoh/ocaml-usb ocaml-usb-1.3.1/_tags000066400000000000000000000000601353230357300144160ustar00rootroot00000000000000: use_libusb # OASIS_START # OASIS_STOP ocaml-usb-1.3.1/config_pkg000077500000000000000000000004101353230357300154310ustar00rootroot00000000000000#!/bin/sh config_lwt () { if ocamlfind query lwt_ppx >/dev/null 2>&1 then patch $RECOVER --no-backup-if-mismatch -r - -f -p1 < patches/use-lwt_ppx.patch fi } case $1 in --distclean) RECOVER=-R config_lwt exit 0 ;; *) config_lwt ;; esac ocaml-usb-1.3.1/configure000077500000000000000000000001111353230357300153020ustar00rootroot00000000000000#!/bin/sh # OASIS_START make configure CONFIGUREFLAGS="$*" # OASIS_STOP ocaml-usb-1.3.1/dist000077500000000000000000000013641353230357300142770ustar00rootroot00000000000000#!/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 ocaml-usb-1.3.1/examples/000077500000000000000000000000001353230357300152205ustar00rootroot00000000000000ocaml-usb-1.3.1/examples/Makefile000066400000000000000000000007761353230357300166720ustar00rootroot00000000000000# 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 ocaml-usb-1.3.1/examples/_tags000066400000000000000000000000451353230357300162370ustar00rootroot00000000000000# -*- conf -*- <*>: thread, pkg_usb ocaml-usb-1.3.1/examples/list_devices.ml000066400000000000000000000005271353230357300202330ustar00rootroot00000000000000(* * list_devices.ml * --------------- * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of ocaml-usb. *) open Lwt 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 ()) ocaml-usb-1.3.1/examples/myocamlbuild.ml000066400000000000000000000065561353230357300202470ustar00rootroot00000000000000(* * 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 ocaml-usb-1.3.1/myocamlbuild.ml000066400000000000000000000026341353230357300164220ustar00rootroot00000000000000(* * 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"] | _ -> ()) ocaml-usb-1.3.1/patches/000077500000000000000000000000001353230357300150315ustar00rootroot00000000000000ocaml-usb-1.3.1/patches/use-lwt_ppx.patch000066400000000000000000000014421353230357300203420ustar00rootroot00000000000000diff --git a/.merlin b/.merlin index 17a31a7..e7badd4 100644 --- a/.merlin +++ b/.merlin @@ -1,4 +1,4 @@ B _build/src S src -PKG lwt lwt.ppx +PKG lwt lwt_ppx FLG -w +a-4-40..42-44-45-48 diff --git a/_oasis b/_oasis index ca157ca..09320c3 100644 --- a/_oasis +++ b/_oasis @@ -17,7 +17,7 @@ Library "usb" FindlibName: usb Path: src Modules: USB - BuildDepends: lwt.unix, lwt.ppx + BuildDepends: lwt.unix, lwt_ppx XMETADescription: Bindings for libusb-1.0 XMETARequires: lwt.unix CSources: usb_stubs.c diff --git a/examples/myocamlbuild.ml b/examples/myocamlbuild.ml index ae525fb..3440abc 100644 --- a/examples/myocamlbuild.ml +++ b/examples/myocamlbuild.ml @@ -42,7 +42,7 @@ let packages = [ "lwt.glib"; "lwt.text"; "lwt.unix"; - "lwt.ppx"; + "lwt_ppx"; "usb"; ] ocaml-usb-1.3.1/setup.ml000066400000000000000000000003471353230357300151000ustar00rootroot00000000000000(* * setup.ml * -------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 *) (* OASIS_START *) #use "topfind";; #require "oasis.dynrun";; open OASISDynRun;; (* OASIS_STOP *) let () = setup ();; ocaml-usb-1.3.1/src/000077500000000000000000000000001353230357300141715ustar00rootroot00000000000000ocaml-usb-1.3.1/src/USB.ml000066400000000000000000000535331353230357300151650ustar00rootroot00000000000000(* * USB.ml * ------ * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of ocaml-usb. *) open Lwt_unix (* +-----------------------------------------------------------------+ | Errors | +-----------------------------------------------------------------+ *) type error = | Error_io | Error_invalid_param | Error_access | Error_no_device | Error_not_found | Error_busy | Error_timeout | Error_overflow | Error_pipe | Error_interrupted | Error_no_mem | Error_not_supported | Error_other exception Error of error * string let _ = Callback.register_exception "ocaml-usb:Error" (Error(Error_access, "")) type transfer_error = | Transfer_error | Transfer_timed_out | Transfer_cancelled | Transfer_stall | Transfer_no_device | Transfer_overflow exception Transfer of transfer_error * string let error_message = function | Error_io -> "Input/output error" | Error_invalid_param -> "Invalid parameter" | Error_access -> "Access denied" | Error_no_device -> "No such device" | Error_not_found -> "Entity not found" | Error_busy -> "Resource busy" | Error_timeout -> "Operation timed out" | Error_overflow -> "Overflow" | Error_pipe -> "Pipe error" | Error_interrupted -> "System call interrupted" | Error_no_mem -> "Insufficient memory" | Error_not_supported -> "Operation not supported or unimplemented on this platform" | Error_other -> "Other error" let transfer_error_message = function | Transfer_error -> "Transfer failed" | Transfer_timed_out -> "Transfer timed out" | Transfer_cancelled -> "Transfer was cancelled" | Transfer_stall -> "Transfer stalled" | Transfer_no_device -> "Device was disconnected" | Transfer_overflow -> "Device sent more data than requested" let () = Printexc.register_printer (function | Error(err, fun_name) -> Some(Printf.sprintf "USB error: '%s' failed: %s" fun_name (error_message err)) | Transfer(err, fun_name) -> Some(Printf.sprintf "USB transfer error: '%s' failed: %s" fun_name (transfer_error_message err)) | exn -> None) let handle_error f arg = try f arg with | Error(err, fun_name) -> Printf.eprintf "%s: %s failed: %s\n%!" Sys.argv.(0) fun_name (error_message err); exit 2 | Transfer(err, fun_name) -> Printf.eprintf "%s: %s failed: %s\n%!" Sys.argv.(0) fun_name (transfer_error_message err); exit 2 (* +-----------------------------------------------------------------+ | Types | +-----------------------------------------------------------------+ *) type device type device_handle type transfer type handle_state = | State_closed | State_detach (* A detached operation is being performed on the device. *) | State_ok type handle = { handle : device_handle; mutable state : handle_state; mutex : Lwt_mutex.t; } type direction = In | Out type endpoint = int type interface = int type recipient = | Device | Interface | Endpoint | Other type request_type = | Standard | Class | Vendor | Reserved type request = int type configuration = int type iso_result = | Iso_ok of int | Iso_error of transfer_error * string (* +-----------------------------------------------------------------+ | Stub functions | +-----------------------------------------------------------------+ *) (* Result of a transfer: *) type 'a result = | OK of 'a | Error of transfer_error external ml_usb_init : unit -> unit = "ml_usb_init" external ml_usb_exit : unit -> unit = "ml_usb_exit" external ml_usb_set_debug : int -> unit = "ml_usb_set_debug" external ml_usb_get_next_timeout : unit -> float = "ml_usb_get_next_timeout" external ml_usb_handle_events : unit -> unit = "ml_usb_handle_events" external ml_usb_get_device_list : unit -> device list = "ml_usb_get_device_list" external ml_usb_get_bus_number : device -> int = "ml_usb_get_bus_number" external ml_usb_get_device_address : device -> int = "ml_usb_get_device_address" external ml_usb_get_max_packet_size : device -> direction -> endpoint -> int = "ml_usb_get_max_packet_size" external ml_usb_open : device -> device_handle = "ml_usb_open" external ml_usb_open_device_with_vid_pid : int -> int -> device_handle option = "ml_usb_open_device_with_vid_pid" external ml_usb_close : device_handle -> unit = "ml_usb_close" external ml_usb_get_device : device_handle -> device = "ml_usb_get_device" external ml_usb_kernel_driver_active : device_handle -> interface -> bool = "ml_usb_kernel_driver_active" external ml_usb_detach_kernel_driver : device_handle -> interface -> unit = "ml_usb_detach_kernel_driver" external ml_usb_attach_kernel_driver : device_handle -> interface -> unit = "ml_usb_attach_kernel_driver" external ml_usb_bulk_recv : device_handle * endpoint * int * string * int * int * (int result -> unit) -> transfer = "ml_usb_bulk_recv" external ml_usb_bulk_send : device_handle * endpoint * int * string * int * int * (int result -> unit) -> transfer = "ml_usb_bulk_send" external ml_usb_interrupt_recv : device_handle * endpoint * int * string * int * int * (int result -> unit) -> transfer = "ml_usb_interrupt_recv" external ml_usb_interrupt_send : device_handle * endpoint * int * string * int * int * (int result -> unit) -> transfer = "ml_usb_interrupt_send" external ml_usb_control_recv : device_handle * endpoint * int * string * int * int * (int result -> unit) * recipient * request_type * request * int * int -> transfer = "ml_usb_control_recv" external ml_usb_control_send : device_handle * endpoint * int * string * int * int * (int result -> unit) * recipient * request_type * request * int * int -> transfer = "ml_usb_control_send" external ml_usb_iso_recv : device_handle * endpoint * int * string * int * int * (int result list result -> unit) * int * int list -> transfer = "ml_usb_iso_recv" external ml_usb_iso_send : device_handle * endpoint * int * string * int * int * (int result list result -> unit) * int * int list -> transfer = "ml_usb_iso_send" external ml_usb_cancel_transfer : transfer -> unit = "ml_usb_cancel_transfer" external ml_usb_claim_interface_job : device_handle -> interface -> [ `claim_interface ] job = "ml_usb_claim_interface_job" external ml_usb_claim_interface_result : [ `claim_interface ] job -> unit = "ml_usb_claim_interface_result" external ml_usb_claim_interface_free : [ `claim_interface ] job -> unit = "ml_usb_claim_interface_free" external ml_usb_release_interface_job : device_handle -> interface -> [ `release_interface ] job = "ml_usb_release_interface_job" external ml_usb_release_interface_result : [ `release_interface ] job -> unit = "ml_usb_release_interface_result" external ml_usb_release_interface_free : [ `release_interface ] job -> unit = "ml_usb_release_interface_free" external ml_usb_get_configuration_job : device_handle -> [ `get_configuration ] job = "ml_usb_get_configuration_job" external ml_usb_get_configuration_result : [ `get_configuration ] job -> configuration = "ml_usb_get_configuration_result" external ml_usb_get_configuration_free : [ `get_configuration ] job -> unit = "ml_usb_get_configuration_free" external ml_usb_set_configuration_job : device_handle -> configuration -> [ `set_configuration ] job = "ml_usb_set_configuration_job" external ml_usb_set_configuration_result : [ `set_configuration ] job -> unit = "ml_usb_set_configuration_result" external ml_usb_set_configuration_free : [ `set_configuration ] job -> unit = "ml_usb_set_configuration_free" external ml_usb_set_interface_alt_setting_job : device_handle -> interface -> int -> [ `set_interface_alt_setting ] job = "ml_usb_set_interface_alt_setting_job" external ml_usb_set_interface_alt_setting_result : [ `set_interface_alt_setting ] job -> unit = "ml_usb_set_interface_alt_setting_result" external ml_usb_set_interface_alt_setting_free : [ `set_interface_alt_setting ] job -> unit = "ml_usb_set_interface_alt_setting_free" external ml_usb_clear_halt_job : device_handle -> endpoint -> [ `clear_halt ] job = "ml_usb_clear_halt_job" external ml_usb_clear_halt_result : [ `clear_halt ] job -> unit = "ml_usb_clear_halt_result" external ml_usb_clear_halt_free : [ `clear_halt ] job -> unit = "ml_usb_clear_halt_free" external ml_usb_reset_device_job : device_handle -> [ `reset_device ] job = "ml_usb_reset_device_job" external ml_usb_reset_device_result : [ `reset_device ] job -> unit = "ml_usb_reset_device_result" external ml_usb_reset_device_free : [ `reset_device ] job -> unit = "ml_usb_reset_device_free" (* +-----------------------------------------------------------------+ | Lwt integration | +-----------------------------------------------------------------+ *) let timeout_fired = ref false let timeout_event = ref Lwt_engine.fake_event let enter_iter () = timeout_fired := false; let timeout = ml_usb_get_next_timeout () in if timeout >= 0. then timeout_event := Lwt_engine.on_timer timeout false (fun _ -> timeout_fired := true) let leave_iter () = Lwt_engine.stop_event !timeout_event; if !timeout_fired then ml_usb_handle_events () let events = Hashtbl.create 42 let insert_pollfd fd check_readable check_writable = let acc = [] in let acc = if check_readable then Lwt_engine.on_readable fd (fun _ -> ml_usb_handle_events ()) :: acc else acc in let acc = if check_writable then Lwt_engine.on_writable fd (fun _ -> ml_usb_handle_events ()) :: acc else acc in Hashtbl.add events fd acc let remove_pollfd fd = List.iter Lwt_engine.stop_event (Hashtbl.find events fd); Hashtbl.remove events fd let () = Callback.register "ocaml-usb:insert-pollfd" insert_pollfd; Callback.register "ocaml-usb:remove-pollfd" remove_pollfd (* +-----------------------------------------------------------------+ | Initialization | +-----------------------------------------------------------------+ *) (* Every function of this module must take care of forcing this before doing anything: *) let init = lazy( (* Initializes libusb. *) ml_usb_init (); (* Integrate libusb timoeuts into lwt. *) ignore (Lwt_sequence.add_r enter_iter Lwt_main.enter_iter_hooks); ignore (Lwt_sequence.add_r leave_iter Lwt_main.leave_iter_hooks); (* Cleanup libusb on exit. *) let exit = lazy(ml_usb_exit ()) in ignore (Lwt_sequence.add_r (fun _ -> Lazy.force exit |> Lwt.return) Lwt_main.exit_hooks) ) let set_debug level = Lazy.force init; ml_usb_set_debug (match level with | `quiet -> 0 | `error -> 1 | `warning -> 2 | `verbose -> 3) (* +-----------------------------------------------------------------+ | Device handling and enumeration | +-----------------------------------------------------------------+ *) let get_device_list () = Lazy.force init; ml_usb_get_device_list () let make_handle device_handle = { handle = device_handle; state = State_ok; mutex = Lwt_mutex.create (); } (* Check that a handle is valid. It must be called before using a handle. *) let check_handle handle = if handle.state = State_closed then failwith "device handle closed" let detach handle job result free = Lwt_mutex.with_lock handle.mutex begin fun () -> check_handle handle; handle.state <- State_detach; Lwt.finalize (fun () -> execute_job ?async_method:None ~job:(job ()) ~result ~free) (fun () -> if handle.state = State_detach then handle.state <- State_ok; Lwt.return ()) end let get_bus_number = ml_usb_get_bus_number let get_device_address = ml_usb_get_device_address let get_max_packet_size ~device ~direction ~endpoint = ml_usb_get_max_packet_size device direction endpoint let open_device device = make_handle (ml_usb_open device) let close handle = if handle.state <> State_closed then begin handle.state <- State_closed; ml_usb_close handle.handle end let get_device handle = ml_usb_get_device handle.handle let claim_interface handle interface = detach handle (fun () -> ml_usb_claim_interface_job handle.handle interface) ml_usb_claim_interface_result ml_usb_claim_interface_free let release_interface handle interface = detach handle (fun () -> ml_usb_release_interface_job handle.handle interface) ml_usb_release_interface_result ml_usb_release_interface_free let kernel_driver_active handle = check_handle handle; ml_usb_kernel_driver_active handle.handle let detach_kernel_driver handle = check_handle handle; ml_usb_detach_kernel_driver handle.handle let attach_kernel_driver handle = check_handle handle; ml_usb_attach_kernel_driver handle.handle let get_configuration handle = detach handle (fun () -> ml_usb_get_configuration_job handle.handle) ml_usb_get_configuration_result ml_usb_get_configuration_free let set_configuration handle configuration = detach handle (fun () -> ml_usb_set_configuration_job handle.handle configuration) ml_usb_set_configuration_result ml_usb_set_configuration_free let set_interface_alt_setting handle interface alt_setting = detach handle (fun () -> ml_usb_set_interface_alt_setting_job handle.handle interface alt_setting) ml_usb_set_interface_alt_setting_result ml_usb_set_interface_alt_setting_free let clear_halt handle endpoint = detach handle (fun () -> ml_usb_clear_halt_job handle.handle endpoint) ml_usb_clear_halt_result ml_usb_clear_halt_free let reset_device handle = detach handle (fun () -> ml_usb_reset_device_job handle.handle) ml_usb_reset_device_result ml_usb_reset_device_free let open_device_with ~vendor_id ~product_id = Lazy.force init; match ml_usb_open_device_with_vid_pid vendor_id product_id with | Some device_handle -> make_handle device_handle | None -> failwith (Printf.sprintf "no such usb device (vendor-id=0x%04x, product-id=0x%04x)" 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 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; } 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; } type config_descriptor = { cd_configuration_value : int; cd_index_configuration : int; cd_attributes : int; cd_max_power : int; cd_interfaces : interface_descriptor array array; } 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" external get_config_descriptor : device -> int -> config_descriptor = "ml_usb_get_config_descriptor" external get_config_descriptor_by_value : device -> int -> config_descriptor = "ml_usb_get_config_descriptor_by_value" module DT = struct type t = int let device = 0x01 let config = 0x02 let string = 0x03 let interface = 0x04 let endpoint = 0x05 let hid = 0x21 let report = 0x22 let physical = 0x23 let hub = 0x2 end (* +-----------------------------------------------------------------+ | IOs | +-----------------------------------------------------------------+ *) (* Handle the result of a transfer *) let handle_result func_name w = function | OK x -> Lwt.wakeup w x | Error error -> Lwt.wakeup_exn w (Transfer(error, func_name)) let make_timeout = function | None -> 0 | Some t -> Pervasives.truncate (t *. 1000.0) let transfer name func ~handle ~endpoint ?timeout buffer offset length = check_handle handle; if offset < 0 || length < 0 || offset > String.length buffer - length then invalid_arg ("USB." ^ name); let waiter, wakener = Lwt.task () in let transfer = func (handle.handle, endpoint, make_timeout timeout, buffer, offset, length, handle_result name wakener) in Lwt.on_cancel waiter (fun () -> ml_usb_cancel_transfer transfer); waiter let bulk_recv = transfer "bulk_recv" ml_usb_bulk_recv let bulk_send = transfer "bulk_send" ml_usb_bulk_send let interrupt_recv = transfer "interrupt_recv" ml_usb_interrupt_recv let interrupt_send = transfer "interrupt_send" ml_usb_interrupt_send let control_transfer name func ~handle ~endpoint ?timeout ?(recipient=Device) ?(request_type=Standard) ~request ~value ~index buffer offset length = check_handle handle; if offset < 0 || length < 0 || offset > String.length buffer - length then invalid_arg ("USB." ^ name); let waiter, wakener = Lwt.task () in let transfer = func (handle.handle, endpoint, make_timeout timeout, buffer, offset, length, handle_result name wakener, recipient, request_type, request, value, index) in Lwt.on_cancel waiter (fun () -> ml_usb_cancel_transfer transfer); waiter let control_recv = control_transfer "control_recv" ml_usb_control_recv let control_send = control_transfer "control_send" ml_usb_control_send let handle_iso_result func_name w = function | OK l -> Lwt.wakeup w (List.rev_map (function | OK x -> Iso_ok x | Error error -> Iso_error(error, func_name)) l) | Error error -> Lwt.wakeup_exn w (Transfer(error, func_name)) let iso_transfer name func ~handle ~endpoint ?timeout buffer offset lengths = check_handle handle; if lengths = [] then Lwt.return [] else begin List.iter (fun length -> if length < 0 then invalid_arg ("USB." ^ name)) lengths; let length = List.fold_left (+) 0 lengths in if offset < 0 || offset > String.length buffer - length then invalid_arg ("USB." ^ name); let waiter, wakener = Lwt.task () in let transfer = func (handle.handle, endpoint, make_timeout timeout, buffer, offset, length, handle_iso_result name wakener, List.length lengths, lengths) in Lwt.on_cancel waiter (fun () -> ml_usb_cancel_transfer transfer); waiter end let iso_recv = iso_transfer "iso_recv" ml_usb_iso_recv let iso_send = iso_transfer "iso_send" ml_usb_iso_send (* +-----------------------------------------------------------------+ | Standard request | +-----------------------------------------------------------------+ *) module Request = struct type t = request let get_status = 0x00 let clear_feature = 0x01 let set_feature = 0x03 let set_address = 0x05 let get_descriptor = 0x06 let set_descriptor = 0x07 let get_configuration = 0x08 let set_configuration = 0x09 let get_interface = 0x0a let set_interface = 0x0b let synch_frame = 0x0c end (* +-----------------------------------------------------------------+ | Helpers | +-----------------------------------------------------------------+ *) let get_string_descriptor handle ?timeout ?lang_id ~index = let data = Bytes.to_string (Bytes.create 255) in let%lwt lang_id = 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 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 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") else Lwt.return (String.sub data 2 (len - 2)) ocaml-usb-1.3.1/src/USB.mli000066400000000000000000000345761353230357300153440ustar00rootroot00000000000000(* * USB.mli * ------- * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of ocaml-usb. *) (** Module for USB communication *) val handle_error : ('a -> 'b) -> 'a -> 'b (** [handle_error f x] applies [f] to [x] and returns the result. If the exception {!Error} or {!Transport} is raised, it prints a message describing the error and exits with code 2. *) (** {6 General errors} *) (** Any function of this module may raise one of the following errors: *) type error = | Error_io (** Error on IOs *) | Error_invalid_param (** Invalid parameter. If this error is raised, then there is a bug in ocaml-usb. Please fill a bug report in this case. *) | Error_access (** Access denied to a peripheral *) | Error_no_device (** No such device (it may have been disconnected) *) | Error_not_found (** Entity not found *) | Error_busy (** Resource busy *) | Error_timeout (** Operation timed out *) | Error_overflow (** Overflow *) | Error_pipe (** Pipe error *) | Error_interrupted (** System call interrupted (perhaps due to signal) *) | Error_no_mem (** Insufficient memory *) | Error_not_supported (** Operation not supported or unimplemented on this platform *) | Error_other (** Other error *) exception Error of error * string (** [Error(error, func_name)] is raised when libusb returns an error. [func_name] is a the name of the function which failed. *) val error_message : error -> string (** [error_message error] returns a human readable description of the error *) (** {6 Types} *) (** A USB endpoint direction *) type direction = In | Out (** A USB endpoint number *) type endpoint = int (** {6 Miscellanies} *) val init : unit Lazy.t (** When forced, [init] initialises libusb. This is automatically done so you do not need to do it manually. By the way you can do it to catch initialisation errors. *) val set_debug : [ `quiet | `error | `warning | `verbose ] -> unit (** [set_debug level] set the debug level. *) (** {6 Device informations} *) type device (** Representation of a device description *) val get_device_list : unit -> device list (** Returns a list of USB devices currently attached to the system. *) val get_bus_number : device -> int (** Get the number of the bus that a device is connected to. *) val get_device_address : device -> int (** Get the address of the device on the bus it is connected to. *) val get_max_packet_size : device : device -> direction : direction -> endpoint : endpoint -> int (** [get_max_packet_size ~device ~direction ~endpoint] Convenience function to retrieve the [wMaxPacketSize] value for a particular endpoint in the active device configuration. *) (** {6 Device use} *) type handle (** A handle allows you to perform I/O on the device in question. *) type interface = int (** An interface number on a device *) val open_device : device -> handle (** Open a device and obtain a device handle. A handle allows you to perform I/O on the device in question. *) val close : handle -> unit (** Close a previously opened device handle *) val open_device_with : vendor_id : int -> product_id : int -> handle (** [open_device_with ~vendor_id ~product_id] Convenience function for finding a device with a particular idVendor/idProduct combination. @raise Failure if the device is not found. *) val get_device : handle -> device (** Get the underlying device for a handle *) val kernel_driver_active : handle -> interface -> bool (** Determine if a kernel driver is active on an interface. If a kernel driver is active, you cannot claim the interface, and libusb will be unable to perform I/O. *) val detach_kernel_driver : handle -> interface -> unit (** Detach a kernel driver from an interface. If successful, you will then be able to claim the interface and perform I/O. *) val attach_kernel_driver : handle -> interface -> unit (** Re-attach an interface's kernel driver, which was previously detached using {!detach_kernel_driver}. *) val claim_interface : handle -> interface -> unit Lwt.t (** [claim_interface handle interface_number] Claim an interface on a given device handle. You must claim the interface you wish to use before you can perform I/O on any of its endpoints. *) val release_interface : handle -> interface -> unit Lwt.t (** Release an interface previously claimed with libusb_claim_interface(). You should release all claimed interfaces before closing a device handle. This is a blocking function. A [SET_INTERFACE] control request will be sent to the device, resetting interface state to the first alternate setting. *) type configuration = int (** A device configuration *) val get_configuration : handle -> configuration Lwt.t (** [get_configuration handle] returns the current configuration of a device *) val set_configuration : handle -> configuration -> unit Lwt.t (** [set_configuration handle conf] change the current configuration of a device *) val set_interface_alt_setting : handle -> interface -> int -> unit Lwt.t (** [set_interface_alt_setting handle interface alternate_setting] activates an alternate setting for an interface. *) val clear_halt : handle -> endpoint -> unit Lwt.t (** [clear_halt handle endpoint] clears the halt/stall condition for an endpoint. *) val reset_device : handle -> unit Lwt.t (** [reset_device handle] reset the given device *) (** {6 USB descriptors} *) (** 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 *) end type device_descriptor = { dd_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; (** USB-IF class code for the device. *) dd_device_sub_class : int; (** USB-IF subclass code for the device, qualified by the [dd_device_class] value. *) dd_device_protocol : int; (** USB-IF protocol code for the device, qualified by the [dd_device_class] and [dd_device_subclass] values. *) dd_max_packet_size : int; (** Maximum packet size for endpoint 0. *) dd_vendor_id : int; (** USB-IF vendor ID. *) dd_product_id : int; (** USB-IF product ID. *) dd_device : int; (** Device release number in binary-coded decimal. *) dd_index_manufacturer : int; (** Index of string descriptor describing manufacturer. *) dd_index_product : int; (** Index of string descriptor describing product. *) dd_index_serial_number : int; (** Index of string descriptor containing device serial number. *) dd_configurations : int; (** Number of possible configurations. *) } 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. *) } type interface_descriptor = { id_interface : int; (** Number of this interface. *) id_alternate_setting : int; (** Value used to select this alternate setting for this interface. *) id_interface_class : Class.t; (** USB-IF class code for this interface. *) id_interface_sub_class : int; (** USB-IF subclass code for this interface, qualified by the [id_interface_class] value. *) id_interface_protocol : int; (** USB-IF protocol code for this interface, qualified by the [id_interface_class] and [id_interface_sub_class] values. *) id_index_interface : int; (** Index of string descriptor describing this interface. *) id_endpoints : endpoint_descriptor array; (** Array of endpoint descriptors. *) } type config_descriptor = { cd_configuration_value : int; (** Identifier value for this configuration *) cd_index_configuration : int; (** Index of string descriptor describing this configuration. *) cd_attributes : int; (** A bitmask, representing configuration characteristics. *) cd_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; (** Array of interfaces supported by this configuration. [cd_interface.(iface).(altsetting)] designate the interface descriptor for interface [iface] with alternate setting [altsetting]. *) } val get_active_config_descriptor : device -> config_descriptor (** Get the USB configuration descriptor for the currently active configuration. *) val get_config_descriptor : device -> int -> config_descriptor (** Get a USB configuration descriptor based on its index. *) 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 val get_string_descriptor : handle -> ?timeout : float -> ?lang_id : int -> index : int -> string Lwt.t (** Retrieve a string descriptor from a device. *) (** {6 IOs} *) (** {8 Errors} *) (** Transfers may fails with any of the following error: *) type transfer_error = | Transfer_error (** Transfer failed *) | Transfer_timed_out (** Transfer timed out *) | Transfer_cancelled (** Transfer was cancelled *) | Transfer_stall (** For bulk/interrupt endpoints: halt condition detected (endpoint stalled). For control endpoints: control request not supported. *) | Transfer_no_device (** Device was disconnected *) | Transfer_overflow (** Device sent more data than requested *) exception Transfer of transfer_error * string (** [Transfer(error, func_name)] Exception raised when a transfer fail. *) val transfer_error_message : transfer_error -> string (** [transfer_error_message error] *) (** {8 Bulk transfers} *) val bulk_recv : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int -> int Lwt.t (** [bulk_recv ~handle ~endpoint ?timeout buffer offset length] *) val bulk_send : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int -> int Lwt.t (** [bulk_send ~handle ~endpoint ?timeout buffer offset length] *) (** {8 Interrupt transfers} *) val interrupt_recv : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int -> int Lwt.t (** [interrupt_recv ~handle ~endpoint ?timeout buffer offset length] *) val interrupt_send : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int -> int Lwt.t (** [interrupt_send ~handle ~endpoint ?timeout buffer offset length] *) (** {8 Isochronous transfers} *) (** Result of the transfer of one packet in an isochronous transfer: *) type iso_result = | Iso_ok of int (** The packet has been transfered successfully *) | Iso_error of transfer_error * string (** [Iso_error(error, func_name)] An error occured *) val iso_recv : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int list -> iso_result list Lwt.t val iso_send : handle : handle -> endpoint : endpoint -> ?timeout : float -> string -> int -> int list -> iso_result list Lwt.t (** {8 Control transfers} *) type recipient = | Device | Interface | Endpoint | Other type request_type = | Standard | Class | Vendor | Reserved type request = int val control_send : handle : handle -> endpoint : endpoint -> ?timeout : float -> ?recipient : recipient -> ?request_type : request_type -> request : request -> value : int -> index : int -> string -> int -> int -> int Lwt.t (** Sends a control packet. @param recipient defaults to {!Device} @param request_type defaults to {!Standard} *) val control_recv : handle : handle -> endpoint : endpoint -> ?timeout : float -> ?recipient : recipient -> ?request_type : request_type -> request : request -> value : int -> index : int -> string -> int -> int -> int Lwt.t (** Receives a control packet. @param recipient defaults to {!Device} @param request_type defaults to {!Standard} *) (** Standard requests *) module Request : sig type t = request val get_status : t (** Request status of the specific recipient *) val clear_feature : t (** Clear or disable a specific feature *) val set_feature : t (** Set or enable a specific feature *) val set_address : t (** Set device address for all future accesses *) val get_descriptor : t (** Get the specified descriptor *) val set_descriptor : t (** Used to update existing descriptors or add new descriptors *) val get_configuration : t (** Get the current device configuration value *) val set_configuration : t (** Set device configuration *) val get_interface : t (** Return the selected alternate setting for the specified interface *) val set_interface : t (** Select an alternate interface for the specified interface *) val synch_frame : t (** Set then report an endpoint's synchronization frame *) end ocaml-usb-1.3.1/src/usb_stubs.c000066400000000000000000000773301353230357300163600ustar00rootroot00000000000000/* * usb_stubs.c * ----------- * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of ocaml-usb. */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include /* +-----------------------------------------------------------------+ | Errors | +-----------------------------------------------------------------+ */ static void ml_usb_error(int code, char *fun_name) { int num; value arg[2]; switch(code) { case LIBUSB_ERROR_IO: num = Val_int(0); break; case LIBUSB_ERROR_INVALID_PARAM: num = Val_int(1); break; case LIBUSB_ERROR_ACCESS: num = Val_int(2); break; case LIBUSB_ERROR_NO_DEVICE: num = Val_int(3); break; case LIBUSB_ERROR_NOT_FOUND: num = Val_int(4); break; case LIBUSB_ERROR_BUSY: num = Val_int(5); break; case LIBUSB_ERROR_TIMEOUT: num = Val_int(6); break; case LIBUSB_ERROR_OVERFLOW: num = Val_int(7); break; case LIBUSB_ERROR_PIPE: num = Val_int(8); break; case LIBUSB_ERROR_INTERRUPTED: num = Val_int(9); break; case LIBUSB_ERROR_NO_MEM: num = Val_int(10); break; case LIBUSB_ERROR_NOT_SUPPORTED: num = Val_int(11); break; case LIBUSB_ERROR_OTHER: num = Val_int(12); break; default: { char str[512]; sprintf(str, "ocaml-usb: unknown error (%d)", code); caml_failwith(str); } } arg[0] = num; arg[1] = caml_copy_string(fun_name); caml_raise_with_args(*caml_named_value("ocaml-usb:Error"), 2, arg); } static void *ml_usb_malloc(size_t size) { void *ptr = malloc(size); if (ptr == NULL) caml_failwith("ocaml-usb: out of memory"); return ptr; } static struct libusb_transfer *ml_usb_alloc_transfer(int count) { struct libusb_transfer *transfer = libusb_alloc_transfer(count); if (transfer == NULL) caml_failwith("ocaml-usb: out of memory"); return transfer; } /* +-----------------------------------------------------------------+ | Event-loop integration | +-----------------------------------------------------------------+ */ CAMLprim value ml_usb_handle_events() { struct timeval tp = { 0, 0 }; int res = libusb_handle_events_timeout(NULL, &tp); if (res) ml_usb_error(res, "handle_event_timeout"); return Val_unit; } CAMLprim value ml_usb_get_next_timeout() { struct timeval tp; if (libusb_get_next_timeout(NULL, &tp) == 1) return caml_copy_double(tp.tv_sec + (tp.tv_usec * 1e-3)); else return caml_copy_double(-1.0); } #if defined(LWT_ON_WINDOWS) # error "ocaml-usb does not work (yet) on windows" #else static void ml_usb_add_pollfd(int fd, short events, void *user_data) { caml_callback3(*caml_named_value("ocaml-usb:insert-pollfd"), Val_int(fd), Val_bool(events & POLLIN), Val_bool(events & POLLOUT)); } static void ml_usb_remove_pollfd(int fd, void *user_data) { caml_callback(*caml_named_value("ocaml-usb:remove-pollfd"), Val_int(fd)); } #endif /* +-----------------------------------------------------------------+ | Initialization | +-----------------------------------------------------------------+ */ CAMLprim value ml_usb_init() { const struct libusb_pollfd** pollfds = NULL; int i = 0; int res = libusb_init(NULL); if (res) ml_usb_error(res, "init"); pollfds = libusb_get_pollfds(NULL); if (pollfds) { for (i = 0; pollfds[i] != NULL; i++ ) { ml_usb_add_pollfd(pollfds[i]->fd, pollfds[i]->events, NULL); } free(pollfds); } libusb_set_pollfd_notifiers(NULL, ml_usb_add_pollfd, ml_usb_remove_pollfd, NULL); return Val_unit; } CAMLprim value ml_usb_exit() { libusb_exit(NULL); return Val_unit; } CAMLprim value ml_usb_set_debug(value level) { #if defined(LIBUSB_API_VERSION) && (LIBUSB_API_VERSION >= 0x01000106) libusb_set_option(NULL, LIBUSB_OPTION_LOG_LEVEL, Int_val(level)); #else libusb_set_debug(NULL, Int_val(level)); #endif return Val_unit; } /* +-----------------------------------------------------------------+ | Device and enumerations | +-----------------------------------------------------------------+ */ #define Endpoint_val(endpoint, direction) (Int_val(endpoint) | (Int_val(direction) == 0 ? LIBUSB_ENDPOINT_IN : LIBUSB_ENDPOINT_OUT)) #define Ptr_val(v) ((long)(*(void**)Data_custom_val(v))) static int ml_usb_compare(value v1, value v2) { return (int)(Ptr_val(v1) - Ptr_val(v2)); } static long ml_usb_hash(value v) { return Ptr_val(v); } #define Device_val(v) *(libusb_device**)Data_custom_val(v) static void ml_usb_device_finalize(value dev) { libusb_unref_device(Device_val(dev)); } static struct custom_operations device_ops = { "usb.device", ml_usb_device_finalize, ml_usb_compare, ml_usb_hash, custom_serialize_default, custom_deserialize_default }; #define Handle_val(v) *(libusb_device_handle**)Data_custom_val(v) static void ml_usb_device_handle_finalize(value vhandle) { libusb_device_handle *handle = Handle_val(vhandle); if (handle) { Handle_val(vhandle) = NULL; libusb_close(handle); } } static struct custom_operations handle_ops = { "usb.device.handle", ml_usb_device_handle_finalize, ml_usb_compare, ml_usb_hash, custom_serialize_default, custom_deserialize_default }; static value alloc_device(libusb_device *device) { value x = caml_alloc_custom(&device_ops, sizeof(libusb_device*), 0, 1); Device_val(x) = device; return x; } static value alloc_handle(libusb_device_handle *handle) { value x = caml_alloc_custom(&handle_ops, sizeof(libusb_device_handle*), 0, 1); Handle_val(x) = handle; return x; } CAMLprim value ml_usb_get_device_list(value unit) { CAMLparam1(unit); CAMLlocal2(x, y); libusb_device **devices; size_t cnt = libusb_get_device_list(NULL, &devices); if ((int)cnt < 0) ml_usb_error(cnt, "get_device_list"); /* Convert the array to a caml list */ size_t i; x = Val_int(0); for (i = 0; i < cnt; i++) { y = caml_alloc_tuple(2); Store_field(y, 0, alloc_device(devices[i])); Store_field(y, 1, x); x = y; } /* Free the list but not the devices */ libusb_free_device_list(devices, 0); CAMLreturn(x); } CAMLprim value ml_usb_get_bus_number(value dev) { return Val_int(libusb_get_bus_number(Device_val(dev))); } CAMLprim value ml_usb_get_device_address(value dev) { return Val_int(libusb_get_device_address(Device_val(dev))); } CAMLprim value ml_usb_get_max_packet_size(value dev, value direction, value endpoint) { int res = libusb_get_max_packet_size(Device_val(dev), Endpoint_val(endpoint, direction)); if (res < 0) ml_usb_error(res, "get_max_packet_size"); return Val_int(res); } CAMLprim value ml_usb_open(value dev) { CAMLparam1(dev); libusb_device_handle *handle = NULL; int res = libusb_open(Device_val(dev), &handle); if (res) ml_usb_error(res, "open"); CAMLreturn(alloc_handle(handle)); } CAMLprim value ml_usb_open_device_with_vid_pid(value vid, value pid) { CAMLparam2(vid, pid); CAMLlocal1(some); libusb_device_handle *handle = libusb_open_device_with_vid_pid(NULL, Int_val(vid), Int_val(pid)); if (handle == NULL) CAMLreturn(Val_int(0)); else { some = caml_alloc_tuple(1); Store_field(some, 0, alloc_handle(handle)); CAMLreturn(some); } } CAMLprim value ml_usb_close(value vhandle) { libusb_device_handle *handle = Handle_val(vhandle); if (handle) { Handle_val(vhandle) = NULL; libusb_close(handle); } return Val_unit; } CAMLprim value ml_usb_get_device(value handle) { CAMLparam1(handle); libusb_device *device = libusb_get_device(Handle_val(handle)); libusb_ref_device(device); CAMLreturn(alloc_device(device)); } CAMLprim value ml_usb_kernel_driver_active(value handle, value interface) { int res = libusb_kernel_driver_active(Handle_val(handle), Int_val(interface)); switch (res) { case 0: return Val_false; case 1: return Val_true; default: ml_usb_error(res, "kernel_driver_active"); return Val_false; } } CAMLprim value ml_usb_detach_kernel_driver(value handle, value interface) { int res = libusb_detach_kernel_driver(Handle_val(handle), Int_val(interface)); if (res) ml_usb_error(res, "detach_kernel_driver"); return Val_unit; } CAMLprim value ml_usb_attach_kernel_driver(value handle, value interface) { int res = libusb_attach_kernel_driver(Handle_val(handle), Int_val(interface)); if (res) ml_usb_error(res, "attach_kernel_driver"); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: claim_interface | +-----------------------------------------------------------------+ */ struct job_claim_interface { struct lwt_unix_job job; libusb_device_handle *handle; int interface; int result; }; #define Job_claim_interface(v) *(struct job_claim_interface**)Data_custom_val(v) static void worker_claim_interface(struct job_claim_interface *job) { job->result = libusb_claim_interface(job->handle, job->interface); } CAMLprim value ml_usb_claim_interface_job(value val_handle, value val_interface) { struct job_claim_interface *job = lwt_unix_new(struct job_claim_interface); job->job.worker = (lwt_unix_job_worker)worker_claim_interface; job->handle = Handle_val(val_handle); job->interface = Int_val(val_interface); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_claim_interface_result(value val_job) { struct job_claim_interface *job = Job_claim_interface(val_job); if (job->result) ml_usb_error(job->result, "claim_interface"); return Val_unit; } CAMLprim value ml_usb_claim_interface_free(value val_job) { struct job_claim_interface *job = Job_claim_interface(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: release_interface | +-----------------------------------------------------------------+ */ struct job_release_interface { struct lwt_unix_job job; libusb_device_handle *handle; int interface; int result; }; #define Job_release_interface(v) *(struct job_release_interface**)Data_custom_val(v) static void worker_release_interface(struct job_release_interface *job) { job->result = libusb_release_interface(job->handle, job->interface); } CAMLprim value ml_usb_release_interface_job(value val_handle, value val_interface) { struct job_release_interface *job = lwt_unix_new(struct job_release_interface); job->job.worker = (lwt_unix_job_worker)worker_release_interface; job->handle = Handle_val(val_handle); job->interface = Int_val(val_interface); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_release_interface_result(value val_job) { struct job_release_interface *job = Job_release_interface(val_job); if (job->result) ml_usb_error(job->result, "release_interface"); return Val_unit; } CAMLprim value ml_usb_release_interface_free(value val_job) { struct job_release_interface *job = Job_release_interface(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: get_configuration | +-----------------------------------------------------------------+ */ struct job_get_configuration { struct lwt_unix_job job; libusb_device_handle *handle; int configuration; int result; }; #define Job_get_configuration(v) *(struct job_get_configuration**)Data_custom_val(v) static void worker_get_configuration(struct job_get_configuration *job) { job->result = libusb_get_configuration(job->handle, &(job->configuration)); } CAMLprim value ml_usb_get_configuration_job(value val_handle) { struct job_get_configuration *job = lwt_unix_new(struct job_get_configuration); job->job.worker = (lwt_unix_job_worker)worker_get_configuration; job->handle = Handle_val(val_handle); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_get_configuration_result(value val_job) { struct job_get_configuration *job = Job_get_configuration(val_job); if (job->result) ml_usb_error(job->result, "get_configuration"); return Val_int(job->configuration); } CAMLprim value ml_usb_get_configuration_free(value val_job) { struct job_get_configuration *job = Job_get_configuration(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: set_configuration | +-----------------------------------------------------------------+ */ struct job_set_configuration { struct lwt_unix_job job; libusb_device_handle *handle; int configuration; int result; }; #define Job_set_configuration(v) *(struct job_set_configuration**)Data_custom_val(v) static void worker_set_configuration(struct job_set_configuration *job) { job->result = libusb_set_configuration(job->handle, job->configuration); } CAMLprim value ml_usb_set_configuration_job(value val_handle, value val_configuration) { struct job_set_configuration *job = lwt_unix_new(struct job_set_configuration); job->job.worker = (lwt_unix_job_worker)worker_set_configuration; job->handle = Handle_val(val_handle); job->configuration = Int_val(val_configuration); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_set_configuration_result(value val_job) { struct job_set_configuration *job = Job_set_configuration(val_job); if (job->result) ml_usb_error(job->result, "set_configuration"); return Val_unit; } CAMLprim value ml_usb_set_configuration_free(value val_job) { struct job_set_configuration *job = Job_set_configuration(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: set_interface_alt_setting | +-----------------------------------------------------------------+ */ struct job_set_interface_alt_setting { struct lwt_unix_job job; libusb_device_handle *handle; int interface; int alt_setting; int result; }; #define Job_set_interface_alt_setting(v) *(struct job_set_interface_alt_setting**)Data_custom_val(v) static void worker_set_interface_alt_setting(struct job_set_interface_alt_setting *job) { job->result = libusb_set_interface_alt_setting(job->handle, job->interface, job->alt_setting); } CAMLprim value ml_usb_set_interface_alt_setting_job(value val_handle, value val_interface, value val_alt_setting) { struct job_set_interface_alt_setting *job = lwt_unix_new(struct job_set_interface_alt_setting); job->job.worker = (lwt_unix_job_worker)worker_set_interface_alt_setting; job->handle = Handle_val(val_handle); job->interface = Int_val(val_interface); job->alt_setting = Int_val(val_alt_setting); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_set_interface_alt_setting_result(value val_job) { struct job_set_interface_alt_setting *job = Job_set_interface_alt_setting(val_job); if (job->result) ml_usb_error(job->result, "set_interface_alt_setting"); return Val_unit; } CAMLprim value ml_usb_set_interface_alt_setting_free(value val_job) { struct job_set_interface_alt_setting *job = Job_set_interface_alt_setting(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: clear_halt | +-----------------------------------------------------------------+ */ struct job_clear_halt { struct lwt_unix_job job; libusb_device_handle *handle; int endpoint; int result; }; #define Job_clear_halt(v) *(struct job_clear_halt**)Data_custom_val(v) static void worker_clear_halt(struct job_clear_halt *job) { job->result = libusb_clear_halt(job->handle, job->endpoint); } CAMLprim value ml_usb_clear_halt_job(value val_handle, value val_endpoint) { struct job_clear_halt *job = lwt_unix_new(struct job_clear_halt); job->job.worker = (lwt_unix_job_worker)worker_clear_halt; job->handle = Handle_val(val_handle); job->endpoint = Int_val(val_endpoint); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_clear_halt_result(value val_job) { struct job_clear_halt *job = Job_clear_halt(val_job); if (job->result) ml_usb_error(job->result, "clear_halt"); return Val_unit; } CAMLprim value ml_usb_clear_halt_free(value val_job) { struct job_clear_halt *job = Job_clear_halt(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | JOB: reset_device | +-----------------------------------------------------------------+ */ struct job_reset_device { struct lwt_unix_job job; libusb_device_handle *handle; int result; }; #define Job_reset_device(v) *(struct job_reset_device**)Data_custom_val(v) static void worker_reset_device(struct job_reset_device *job) { job->result = libusb_reset_device(job->handle); } CAMLprim value ml_usb_reset_device_job(value val_handle) { struct job_reset_device *job = lwt_unix_new(struct job_reset_device); job->job.worker = (lwt_unix_job_worker)worker_reset_device; job->handle = Handle_val(val_handle); return lwt_unix_alloc_job(&(job->job)); } CAMLprim value ml_usb_reset_device_result(value val_job) { struct job_reset_device *job = Job_reset_device(val_job); if (job->result) ml_usb_error(job->result, "reset_device"); return Val_unit; } CAMLprim value ml_usb_reset_device_free(value val_job) { struct job_reset_device *job = Job_reset_device(val_job); lwt_unix_free_job(&job->job); return Val_unit; } /* +-----------------------------------------------------------------+ | USB descriptors | +-----------------------------------------------------------------+ */ CAMLprim value ml_usb_get_device_descriptor(value device) { CAMLparam1(device); CAMLlocal1(result); struct libusb_device_descriptor desc; int res = libusb_get_device_descriptor(Device_val(device), &desc); if (res) ml_usb_error(res, "get_device_descriptor"); result = caml_alloc_tuple(12); Store_field(result, 0, Val_int(desc.bcdUSB)); Store_field(result, 1, Val_int(desc.bDeviceClass)); Store_field(result, 2, Val_int(desc.bDeviceSubClass)); Store_field(result, 3, Val_int(desc.bDeviceProtocol)); Store_field(result, 4, Val_int(desc.bMaxPacketSize0)); Store_field(result, 5, Val_int(desc.idVendor)); Store_field(result, 6, Val_int(desc.idProduct)); Store_field(result, 7, Val_int(desc.bcdDevice)); Store_field(result, 8, Val_int(desc.iManufacturer)); Store_field(result, 9, Val_int(desc.iProduct)); Store_field(result, 10, Val_int(desc.iSerialNumber)); Store_field(result, 11, Val_int(desc.bNumConfigurations)); CAMLreturn(result); } static value copy_config_descriptor(struct libusb_config_descriptor *cd) { CAMLparam0(); CAMLlocal5(result, iface, ifaces, altsettings, endpoint); CAMLlocal1(endpoints); result = caml_alloc_tuple(5); Store_field(result, 0, Val_int(cd->bConfigurationValue)); Store_field(result, 1, Val_int(cd->iConfiguration)); Store_field(result, 2, Val_int(cd->bmAttributes)); Store_field(result, 3, Val_int(cd->MaxPower)); ifaces = caml_alloc_tuple(cd->bNumInterfaces); Store_field(result, 4, ifaces); int i, j, k; for (i = 0; i < cd->bNumInterfaces; i++) { altsettings = caml_alloc_tuple(cd->interface[i].num_altsetting); Store_field(ifaces, i, altsettings); for (j = 0; j < cd->interface[i].num_altsetting; j++) { iface = caml_alloc_tuple(7); Store_field(altsettings, j, iface); Store_field(iface, 0, Val_int(cd->interface[i].altsetting[j].bInterfaceNumber)); Store_field(iface, 1, Val_int(cd->interface[i].altsetting[j].bAlternateSetting)); Store_field(iface, 2, Val_int(cd->interface[i].altsetting[j].bInterfaceClass)); Store_field(iface, 3, Val_int(cd->interface[i].altsetting[j].bInterfaceSubClass)); Store_field(iface, 4, Val_int(cd->interface[i].altsetting[j].bInterfaceProtocol)); Store_field(iface, 5, Val_int(cd->interface[i].altsetting[j].iInterface)); endpoints = caml_alloc_tuple(cd->interface[i].altsetting[j].bNumEndpoints); Store_field(iface, 6, endpoints); for (k = 0; k < cd->interface[i].altsetting[j].bNumEndpoints; k++) { endpoint = caml_alloc_tuple(6); Store_field(endpoints, k, endpoint); Store_field(endpoint, 0, Val_int(cd->interface[i].altsetting[j].endpoint[k].bEndpointAddress)); Store_field(endpoint, 1, Val_int(cd->interface[i].altsetting[j].endpoint[k].bmAttributes)); Store_field(endpoint, 2, Val_int(cd->interface[i].altsetting[j].endpoint[k].wMaxPacketSize)); Store_field(endpoint, 3, Val_int(cd->interface[i].altsetting[j].endpoint[k].bInterval)); Store_field(endpoint, 4, Val_int(cd->interface[i].altsetting[j].endpoint[k].bRefresh)); Store_field(endpoint, 5, Val_int(cd->interface[i].altsetting[j].endpoint[k].bSynchAddress)); } } } libusb_free_config_descriptor(cd); CAMLreturn(result); } CAMLprim value ml_usb_get_active_config_descriptor(value device) { struct libusb_config_descriptor *cd; int res = libusb_get_active_config_descriptor(Device_val(device), &cd); if (res) ml_usb_error(res, "get_active_config_descriptor"); return copy_config_descriptor(cd); } CAMLprim value ml_usb_get_config_descriptor(value device, value index) { struct libusb_config_descriptor *cd; int res = libusb_get_config_descriptor(Device_val(device), Int_val(index), &cd); if (res) ml_usb_error(res, "get_config_descriptor"); return copy_config_descriptor(cd); } CAMLprim value ml_usb_get_config_descriptor_by_value(value device, value val) { struct libusb_config_descriptor *cd; int res = libusb_get_config_descriptor_by_value(Device_val(device), Int_val(val), &cd); if (res) ml_usb_error(res, "get_config_descriptor_by_value"); return copy_config_descriptor(cd); } /* +-----------------------------------------------------------------+ | IOs | +-----------------------------------------------------------------+ */ #define Transfer_val(v) *(struct libusb_transfer**)Data_custom_val(v) static struct custom_operations transfer_ops = { "usb.transfer", custom_finalize_default, ml_usb_compare, ml_usb_hash, custom_serialize_default, custom_deserialize_default }; static value alloc_transfer(struct libusb_transfer *transfer) { value x = caml_alloc_custom(&transfer_ops, sizeof(struct libusb_transfer*), 0, 1); Transfer_val(x) = transfer; return x; } CAMLprim value ml_usb_cancel_transfer(value transfer) { int res = libusb_cancel_transfer(Transfer_val(transfer)); if (res) ml_usb_error(res, "cancel_transfer"); return Val_unit; } /* Allocate a buffer, taking cares of remarks about overflows from the libsub documentation: */ static unsigned char *ml_usb_alloc_buffer(int length) { int rest = length % 512; if (rest) length = length - rest + 512; return (unsigned char*)ml_usb_malloc(length); } /* Convert an error transfer status to an exception */ static value ml_usb_transfer_error(enum libusb_transfer_status status) { switch(status) { case LIBUSB_TRANSFER_ERROR: return Val_int(0); case LIBUSB_TRANSFER_TIMED_OUT: return Val_int(1); case LIBUSB_TRANSFER_CANCELLED: return Val_int(2); case LIBUSB_TRANSFER_STALL: return Val_int(3); case LIBUSB_TRANSFER_NO_DEVICE: return Val_int(4); case LIBUSB_TRANSFER_OVERFLOW: return Val_int(5); default: return Val_int(0); } } /* Construct the result of an isochronous transfer: */ static value ml_usb_iso_result(struct libusb_transfer *transfer) { CAMLparam0(); CAMLlocal3(list, x, y); int i; for (i = 0; i < transfer->num_iso_packets; i++) { if (transfer->iso_packet_desc[i].status == LIBUSB_TRANSFER_COMPLETED) { x = caml_alloc(1, 0); Store_field(x, 0, Val_int(transfer->iso_packet_desc[i].actual_length)); } else { x = caml_alloc(1, 1); Store_field(x, 0, ml_usb_transfer_error(transfer->status)); } y = caml_alloc_tuple(2); Store_field(y, 0, x); Store_field(y, 1, list); list = y; } CAMLreturn(list); } /* Handler for device-to-host transfers: */ static void ml_usb_handle_recv(struct libusb_transfer *transfer) { CAMLparam0(); CAMLlocal2(meta, result); /* Metadata of the transfer: */ meta = (value)(transfer->user_data); if (transfer->status == LIBUSB_TRANSFER_COMPLETED) { int leading_setup = 0; if (transfer->type == LIBUSB_TRANSFER_TYPE_CONTROL) leading_setup = LIBUSB_CONTROL_SETUP_SIZE; /* Copy bytes from the C memory to the caml string: */ memcpy(String_val(Field(meta, 1)) + Long_val(Field(meta, 2)), transfer->buffer + leading_setup, transfer->actual_length); /* Returns [OK actual_length] */ result = caml_alloc(1, 0); if (transfer->num_iso_packets == 0) /* Classic transfer */ Store_field(result, 0, Val_int(transfer->actual_length)); else /* Isochronous transfer */ Store_field(result, 0, ml_usb_iso_result(transfer)); } else { /* Returns [Error status] */ result = caml_alloc(1, 1); Store_field(result, 0, ml_usb_transfer_error(transfer->status)); } /* Unregister the memory root: */ caml_remove_generational_global_root((value*)(&(transfer->user_data))); /* Cleanup allocated structures: */ free(transfer->buffer); libusb_free_transfer(transfer); /* Call the ocaml handler: */ caml_callback(Field(meta, 0), result); CAMLreturn0; } /* Handler for host-to-device transfers: */ void ml_usb_handle_send(struct libusb_transfer *transfer) { CAMLparam0(); CAMLlocal2(caml_func, result); /* Metadata contains only the caml callback: */ caml_func = (value)(transfer->user_data); if (transfer->status == LIBUSB_TRANSFER_COMPLETED) { result = caml_alloc(1, 0); if (transfer->num_iso_packets == 0) /* Classic transfer */ Store_field(result, 0, Val_int(transfer->actual_length)); else /* Isochronous transfer */ Store_field(result, 0, ml_usb_iso_result(transfer)); } else { /* Returns [Error status] */ result = caml_alloc(1, 1); Store_field(result, 0, ml_usb_transfer_error(transfer->status)); } /* Unregister the memory root: */ caml_remove_generational_global_root((value*)(&(transfer->user_data))); /* Cleanup allocated structures: */ free(transfer->buffer); libusb_free_transfer(transfer); /* Call the ocaml handler: */ caml_callback(caml_func, result); CAMLreturn0; } /* Alloc a transfer and fill it with common informations: */ static void ml_usb_fill_control_setup(void *buf, value desc, enum libusb_endpoint_direction direction); struct libusb_transfer *ml_usb_transfer(value desc /* the description provided by the caml function: */, value meta /* metadata for the callback */, enum libusb_transfer_type type, enum libusb_endpoint_direction direction, int num_iso_packets) { struct libusb_transfer *transfer = ml_usb_alloc_transfer(num_iso_packets); transfer->dev_handle = Handle_val(Field(desc, 0)); transfer->endpoint = Int_val(Field(desc, 1)) | direction; transfer->timeout = Int_val(Field(desc, 2)); int length = Int_val(Field(desc, 5)); if (type == LIBUSB_TRANSFER_TYPE_CONTROL) length += LIBUSB_CONTROL_SETUP_SIZE; transfer->buffer = ml_usb_alloc_buffer(length); transfer->length = length; transfer->user_data = (void*)meta; transfer->num_iso_packets = num_iso_packets; transfer->type = type; if (type == LIBUSB_TRANSFER_TYPE_CONTROL) ml_usb_fill_control_setup(transfer->buffer, desc, direction); /* Register metadata as a memory root, because we need it for the callback which will be called later: */ caml_register_generational_global_root((value*)(&(transfer->user_data))); return transfer; } /* Device-to-host transfers, for interrupt or bulk transfers: */ CAMLprim value ml_usb_recv(value desc, enum libusb_transfer_type type, int num_iso_packets) { CAMLparam1(desc); CAMLlocal1(meta); /* Metadata for the transfer: */ meta = caml_alloc_tuple(3); /* - the caml callback: */ Store_field(meta, 0, Field(desc, 6)); /* - the caml buffer: */ Store_field(meta, 1, Field(desc, 3)); /* - the offset in the buffer: */ Store_field(meta, 2, Field(desc, 4)); struct libusb_transfer *transfer = ml_usb_transfer(desc, meta, type, LIBUSB_ENDPOINT_IN, num_iso_packets); transfer->callback = ml_usb_handle_recv; int res = libusb_submit_transfer(transfer); if (res) ml_usb_error(res, "submit_transfer"); CAMLreturn(alloc_transfer(transfer)); } /* Host-to-device transfers, for interrupt or bulk transfers: */ CAMLprim value ml_usb_send(value desc, enum libusb_transfer_type type, int num_iso_packets) { /* Metadata contains only the callback: */ struct libusb_transfer *transfer = ml_usb_transfer(desc, Field(desc, 6), type, LIBUSB_ENDPOINT_OUT, num_iso_packets); transfer->callback = ml_usb_handle_send; /* Copy data to send from the managed memory to the C memory: */ int leading_setup = 0; if (type == LIBUSB_TRANSFER_TYPE_CONTROL) leading_setup = LIBUSB_CONTROL_SETUP_SIZE; memcpy(transfer->buffer + leading_setup, String_val(Field(desc, 3)) + Long_val(Field(desc, 4)), Long_val(Field(desc, 5))); int res = libusb_submit_transfer(transfer); if (res) ml_usb_error(res, "submit_transfer"); return alloc_transfer(transfer); } CAMLprim value ml_usb_bulk_recv(value desc) { return ml_usb_recv(desc, LIBUSB_TRANSFER_TYPE_BULK, 0); } CAMLprim value ml_usb_bulk_send(value desc) { return ml_usb_send(desc, LIBUSB_TRANSFER_TYPE_BULK, 0); } CAMLprim value ml_usb_interrupt_recv(value desc) { return ml_usb_recv(desc, LIBUSB_TRANSFER_TYPE_INTERRUPT, 0); } CAMLprim value ml_usb_interrupt_send(value desc) { return ml_usb_send(desc, LIBUSB_TRANSFER_TYPE_INTERRUPT, 0); } /* Generic function which filling the data section of a control transfer: */ static void ml_usb_fill_control_setup(void *buf, value desc, enum libusb_endpoint_direction direction) { libusb_fill_control_setup(buf, /* bmRequestType */ Int_val(Field(desc, 7)) | (Int_val(Field(desc, 8)) << 5) | direction, /* bRequest */ Int_val(Field(desc, 9)), /* wValue */ libusb_cpu_to_le16(Int_val(Field(desc, 10))), /* wIndex */ libusb_cpu_to_le16(Int_val(Field(desc, 11))), /* wLength */ libusb_cpu_to_le16(Int_val(Field(desc, 5))) ); } CAMLprim value ml_usb_control_recv(value desc) { return ml_usb_recv(desc, LIBUSB_TRANSFER_TYPE_CONTROL, 0); } CAMLprim value ml_usb_control_send(value desc) { return ml_usb_send(desc, LIBUSB_TRANSFER_TYPE_CONTROL, 0); } CAMLprim value ml_usb_iso(value desc, enum libusb_endpoint_direction direction) { int num_iso_packets = Int_val(Field(desc, 7)); value val_transfer; if (direction == LIBUSB_ENDPOINT_IN) val_transfer = ml_usb_recv(desc, LIBUSB_TRANSFER_TYPE_ISOCHRONOUS, num_iso_packets); else val_transfer = ml_usb_send(desc, LIBUSB_TRANSFER_TYPE_ISOCHRONOUS, num_iso_packets); struct libusb_transfer *transfer = Transfer_val(val_transfer); int i; value x = Field(desc, 8); for (i = 0; i < num_iso_packets; i++, x = Field(x, 1)) transfer->iso_packet_desc[i].length = Int_val(Field(x, 0)); return val_transfer; } CAMLprim value ml_usb_iso_recv(value desc) { return ml_usb_iso(desc, LIBUSB_ENDPOINT_IN); } CAMLprim value ml_usb_iso_send(value desc) { return ml_usb_iso(desc, LIBUSB_ENDPOINT_OUT); } ocaml-usb-1.3.1/usb.opam000066400000000000000000000021541353230357300150530ustar00rootroot00000000000000opam-version: "2.0" version: "dev" authors: "Jeremie Dimino " maintainer: "letoh" license: "BSD-3-Clause" homepage: "https://github.com/letoh/ocaml-usb" bug-reports: "https://github.com/letoh/ocaml-usb/issues" dev-repo: "git+https://github.com/letoh/ocaml-usb.git" depends: [ "ocaml" {>= "4.02.0"} ("lwt" {>= "2.4.7"} & "lwt" {< "4.0.0"} | "lwt_ppx") "ocamlfind" {build} "oasis" {build & >= "0.3.0"} "ocamlbuild" {build} "conf-pkg-config" {build} ] depexts: [ ["libusb-1.0-0-dev"] {os-family = "debian"} ["libusb"] {os-family = "arch"} ["libusb-dev"] {os-family = "alpine"} ["libusb1-devel"] {os-family = "rhel"} ["libusb1-devel"] {os-family = "fedora"} ["libusb-1_0-devel"] {os-family = "suse"} ["libusb1.0-devel"] {os-family = "mageia"} ] patches: [ "patches/use-lwt_ppx.patch" {lwt:version >= "4.0.0"} ] build: [ ["./configure"] ["./configure" "--enable-tests"] {with-test} [make] [make "doc"] {with-doc} [make "test"] {with-test} ] install: [make "install"] remove: [["ocamlfind" "remove" "usb"]] synopsis: "OCaml bindings for libusb-1.0" flags: light-uninstall