Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 440 lines (371 sloc) 15.314 kB
0e92d26 @soemraws First commit
authored
1 ;;;; libusb-ffi.lisp
2
3 (in-package #:libusb-ffi)
4
5 (define-foreign-library libusb
6 (:unix (:or "libusb-0.1.so.4.4" "libusb-0.1.so.4" "libusb-0.1.so"))
7 (:windows "libusb0")
8 (t (:default "libusb")))
9
10 (use-foreign-library libusb)
11
12 ;;; FFI
13
14 (defctype bus-ptr :pointer)
15 (defctype device-ptr :pointer)
16 (defctype device-handle-ptr :pointer)
17
e237135 @sionescu Fixes for CFFI 0.11.0
sionescu authored
18 (defctype bus (:struct bus))
19 (defctype endpoint-descriptor (:struct endpoint-descriptor))
20 (defctype setting (:struct setting))
21 (defctype interface (:struct interface))
22 (defctype configuration (:struct configuration))
23 (defctype device-descriptor (:struct device-descriptor))
24 (defctype device (:struct device))
25
0e92d26 @soemraws First commit
authored
26 (defcfun (usb-init* "usb_init") :void)
27
28 (defcfun (usb-find-busses* "usb_find_busses") :int)
29
30 (defcfun (usb-find-devices* "usb_find_devices") :int)
31
32 (defcfun (usb-get-busses* "usb_get_busses") bus-ptr)
33
34 (defcfun "usb_open" device-handle-ptr
35 "Open a usb device and return a pointer to the handle to be used for
36 communications."
37 (device device-ptr))
38
39 (defcfun "usb_close" :void
40 "Close a usb device by the pointer to its handle."
41 (handle device-handle-ptr))
42
43 (defcfun (usb-get-string-simple* "usb_get_string_simple") :int
44 (handle device-handle-ptr)
45 (index :int)
46 (buffer :pointer)
e237135 @sionescu Fixes for CFFI 0.11.0
sionescu authored
47 (buffer-size size-t))
0e92d26 @soemraws First commit
authored
48
49 (defcfun (usb-get-string* "usb_get_string") :int
50 (handle device-handle-ptr)
51 (index :int)
52 (language-id :int)
53 (buffer :pointer)
e237135 @sionescu Fixes for CFFI 0.11.0
sionescu authored
54 (buffer-size size-t))
0e92d26 @soemraws First commit
authored
55
56 (defcfun (usb-claim-interface* "usb_claim_interface") :int
57 (handle device-handle-ptr)
58 (interface :int))
59
60 (defcfun (usb-release-interface* "usb_release_interface") :int
61 (handle device-handle-ptr)
62 (interface :int))
63
64 (defcfun (usb-set-configuration* "usb_set_configuration") :int
65 (handle device-handle-ptr)
66 (configuration :int))
67
68 (defcfun (usb-set-altinterface* "usb_set_altinterface") :int
69 (handle device-handle-ptr)
70 (alternate :int))
71
72 (defcfun (usb-clear-halt* "usb_clear_halt") :int
73 (handle device-handle-ptr)
74 (endpoint :unsigned-int))
75
76 (defcfun (usb-reset* "usb_reset") :int
77 (handle device-handle-ptr))
78
79 (defcfun (usb-bulk-write* "usb_bulk_write") :int
80 (handle device-handle-ptr)
81 (endpoint :int)
82 (bytes :pointer)
83 (size :int)
84 (timeout :int))
85
86 (defcfun (usb-bulk-read* "usb_bulk_read") :int
87 (handle device-handle-ptr)
88 (endpoint :int)
89 (bytes :pointer)
90 (size :int)
91 (timeout :int))
92
93 (defcfun (usb-interrupt-write* "usb_interrupt_write") :int
94 (handle device-handle-ptr)
95 (endpoint :int)
96 (bytes :pointer)
97 (size :int)
98 (timeout :int))
99
100 (defcfun (usb-interrupt-read* "usb_interrupt_read") :int
101 (handle device-handle-ptr)
102 (endpoint :int)
103 (bytes :pointer)
104 (size :int)
105 (timeout :int))
106
107 ;;;; Somewhat cleaned up interface
108
109 ;;; Errors
110 (define-condition libusb-error (error)
111 ((text :initarg :text))
112 (:documentation "An error from the libusb library.")
113 (:report
114 (lambda (condition stream)
115 (write-string (slot-value condition 'text)
116 stream))))
117
118 ;;; Core
119 (defvar *libusb-initialized* nil
120 "Boolean indicating if libusb has been initialized.")
121
122 (defun usb-init ()
123 "Initialize the libusb library. It's not necessary to call this
124 directly, since other (Lisp) functions will do so if required."
125 (unless *libusb-initialized*
126 (usb-init*)
127 (setf *libusb-initialized* t))
128 (values))
129
130 (defun ensure-libusb-initialized ()
131 "Make sure the libusb library is initialised and all busses and
132 devices are found."
133 (unless *libusb-initialized*
134 (usb-init))
135 (usb-find-busses*)
136 (usb-find-devices*)
137 (values))
138
139 (defun usb-find-busses ()
140 "Find all of the busses on the system. Returns the number of changes,
141 which specifies the total of new busses and busses removed since
142 previous call to this function."
143 (ensure-libusb-initialized)
144 (usb-find-busses*))
145
146 (defun usb-find-devices ()
147 "Find all of the devices on each bus. This should be called after
148 usb-find-busses. Returns the number of changes, which specifies the
149 total of new devices and devices removed since the previous call to
150 this function."
151 (ensure-libusb-initialized)
152 (usb-find-devices*))
153
154 (defun usb-get-busses ()
155 "Return a list of busses."
156 (ensure-libusb-initialized)
157 (loop with bus = (usb-get-busses*)
158
159 until (null-pointer-p bus)
160 collect bus
161
162 do (setf bus (foreign-slot-value bus 'bus 'next))))
163
164 (defun usb-get-devices* (bus)
165 "Returns a list of all devices in the given bus."
166 (ensure-libusb-initialized)
167 (loop with device = (foreign-slot-value bus 'bus 'devices)
168
169 until (null-pointer-p device)
170 collect device
171
172 do (setf device (foreign-slot-value device 'device 'next))))
173
174 (defun usb-get-devices (&optional (bus-or-list (usb-get-busses)))
175 "Returns a list of all usb devices. Optionally, a bus or list of
176 busses can also be specified, to confine the results to devices on
177 those busses."
178 (if (listp bus-or-list)
179 (loop for bus in bus-or-list
180 nconcing (usb-get-devices* bus))
181 (usb-get-devices* bus-or-list)))
182
183 (defun usb-get-devices-by-ids (vendor-id product-id)
184 "Returns a list of all devices with the given vendor id and product
185 id. If any of the arguments is NIL, then the device id can match any
186 value. Thus (usb-get-devices-by-ids nil nil) is equivalent
187 to (usb-get-devices)."
188 (flet ((ids-match (device)
189 (and (or (null vendor-id)
190 (= vendor-id (usb-get-vendor-id device)))
191 (or (null product-id)
192 (= product-id (usb-get-product-id device))))))
193 (delete-if-not #'ids-match (usb-get-devices))))
194
195
196 ;;; Device operations
197 (defun usb-device-get-descriptor (device)
198 "Returns the device descriptor for the given device."
199 (foreign-slot-pointer device 'device 'descriptor))
200
201 (defun usb-get-configurations (device)
202 "Returns a list of usb configurations for the given device."
203 (let* ((descriptor (usb-device-get-descriptor device))
204 (total-configurations
205 (foreign-slot-value descriptor 'device-descriptor
206 'number-of-configurations)))
207 (loop for index from 0 below total-configurations
208 collect (inc-pointer (foreign-slot-value device
209 'device
210 'configuration)
211 index))))
212
213 (defun usb-configuration-get-value (configuration)
214 "Returns the configuration value of the given configuration."
215 (foreign-slot-value configuration 'configuration
216 'configuration-value))
217
218 (defun usb-get-configuration-by-value (device value)
219 "Returns a configuration which has the given configuration value."
220 (find value (usb-get-configurations device)
221 :test #'(lambda (val config)
222 (= val (usb-configuration-get-value config)))))
223
224 (defun usb-configuration-get-interfaces (configuration)
225 "Returns all the interfaces from the given configuration."
226 (with-foreign-slots ((number-of-interfaces interface)
227 configuration configuration)
228 (loop for index from 0 below number-of-interfaces
229 collect (inc-pointer interface index))))
230
231 (defun usb-interface-get-settings (interface)
232 "Returns all the possible settings from a given interface."
233 (with-foreign-slots ((number-of-settings setting)
234 interface interface)
235 (loop for index from 0 below number-of-settings
236 collect (inc-pointer setting index))))
237
238 (defun usb-interface-setting-get-number (setting)
239 "Return the interface number for the given interface setting."
240 (foreign-slot-value setting 'setting 'interface-number))
241
242 (defun usb-interface-setting-get-alternate (setting)
243 "Return the alternate interface setting value for the given setting."
244 (foreign-slot-value setting 'setting 'alternate-setting))
245
246 (defun usb-interface-setting-get-endpoints (setting)
247 "Return a list of endpoints for the given interface setting."
248 (with-foreign-slots ((number-of-endpoints endpoint-descriptor)
249 setting setting)
250 (loop for index from 0 below number-of-endpoints
251 collect (inc-pointer endpoint-descriptor index))))
252
253 (defun usb-endpoint-get-address (endpoint)
254 "Returns the endpoint's address."
255 (foreign-slot-value endpoint 'endpoint-descriptor 'address))
256
257 (defun usb-endpoint-type (endpoint)
258 "Returns the endpoint's type. This can be
259 :control, :isosynchronous, :bulk or :interrupt."
260 (case
261 (logand (foreign-slot-value endpoint 'endpoint-descriptor 'attributes)
262 #x03)
263 (0 :control)
264 (1 :isosynchronous)
265 (2 :bulk)
266 (3 :interrupt)))
267
268 (defun usb-clear-halt (handle endpoint)
269 "Clear the halt status on the specified endpoint. The endpoint can
270 also be specified by its address."
271 (unless (integerp endpoint)
272 (setf endpoint (usb-endpoint-get-address endpoint)))
273 (unless (zerop (usb-clear-halt* handle endpoint))
274 (error 'libusb-error
275 :text (format nil "Error clearing halt status on endpoint with address 0x~X."
276 endpoint))))
277
278 (defun usb-reset (handle)
279 "Resets the specified device by sending a RESET down the port it is
280 connected to. Note that this causes re-enumeration: After calling
281 usb-reset, the device will need to re-enumerate and thusly, requires
282 you to find the new device and open a new handle. The handle used to
283 call usb-reset will no longer work."
284 (unless (zerop (usb-reset* handle))
285 (error 'libusb-error :text "Error resetting device.")))
286
287 (defun usb-claim-interface (handle setting-or-number)
288 "Claim the given interface for the handle. The interface can be
289 specified by its setting, or its (integer) number."
290 (usb-claim-interface*
291 handle
292 (if (pointerp setting-or-number)
2b3a113 @sionescu Fix typo
sionescu authored
293 (usb-interface-setting-get-number setting-or-number)
0e92d26 @soemraws First commit
authored
294 setting-or-number)))
295
296 (defun usb-release-interface (handle setting-or-number)
297 "Release the given interface for the handle. The interface can be
298 specified by its setting, or its (integer) number."
299 (usb-release-interface*
300 handle
301 (if (pointerp setting-or-number)
302 (usb-interface-setting-get-number setting-or-number)
303 setting-or-number)))
304
305 (defun usb-set-configuration (handle configuration-or-number)
306 "Set the given configuration for the handle. The configuration can
307 be specified also by its (integer) value."
308 (usb-set-configuration*
309 handle
310 (if (pointerp configuration-or-number)
311 (usb-configuration-get-value configuration-or-number)
312 configuration-or-number)))
313
314 (defun usb-set-altinterface (handle setting-or-number)
315 "Set the alternate interface setting to that of the given
316 setting. The alternate interface setting can be specified by
317 setting, or by its (integer) value."
318 (usb-set-altinterface*
319 handle
320 (if (pointerp setting-or-number)
ade1961 @soemraws Typo corrected in usb-set-altinterface
authored
321 (usb-interface-setting-get-alternate setting-or-number)
0e92d26 @soemraws First commit
authored
322 setting-or-number)))
323
324 (defun usb-get-vendor-id (device)
325 "Returns the vendor id of the device."
326 (foreign-slot-value (usb-device-get-descriptor device) 'device-descriptor 'id-vendor))
327
328 (defun usb-get-product-id (device)
329 "Returns the product id of the device."
330 (foreign-slot-value (usb-device-get-descriptor device) 'device-descriptor 'id-product))
331
332 ;;; Control transfers
333 (defun usb-get-string-index (device string-symbol)
334 "Returns the string index associated with the given symbol. This
335 symbol can be :MANUFACTURER, :PRODUCT or :SERIAL-NUMBER."
336 (let ((descriptor (usb-device-get-descriptor device)))
337 (foreign-slot-value descriptor
338 'device-descriptor
339 (intern (concatenate 'string "INDEX-" (string string-symbol))
340 :libusb-ffi))))
341
342 (defun usb-get-string (device-handle index &optional language-id)
343 "Returns the string descriptor specified by index and langid from a
344 device. The string will be returned in Unicode as specified by the
345 USB specification. If language id is nil (the default), returns the
346 string descriptor specified by index in the first language for the
347 descriptor and converts it into C style ASCII. Returns the number of
348 bytes returned."
349 (let (bytes-read string)
350 (setf string
351 (if language-id
352 (with-foreign-pointer-as-string ((buffer buffer-size) 128 :encoding :utf-16)
353 (setf bytes-read
354 (usb-get-string* device-handle index language-id buffer buffer-size)))
355 (with-foreign-pointer-as-string ((buffer buffer-size) 128 :encoding :ascii)
356 (setf bytes-read
357 (usb-get-string-simple* device-handle index buffer buffer-size)))))
358 (if (< bytes-read 0)
359 (error 'libusb-error :text (format nil "Error reading string at index ~D~@[ with language id ~D~]."
360 index language-id))
361 string)))
362
363
364 ;;; Bulk transfers
365 (defun usb-bulk-write (handle endpoint buffer timeout)
366 "Perform a bulk write request to the endpoint, which can
367 alternatively be specified by its address. Buffer should be a
368 foreign array of type vector-unsigned-byte-8. Returns number of
369 bytes written."
370 (unless (integerp endpoint)
371 (setf endpoint (usb-endpoint-get-address endpoint)))
00e9e9e @sionescu Remove superfluous variable
sionescu authored
372 (let* ((bytes-written
0e92d26 @soemraws First commit
authored
373 (usb-bulk-write* handle endpoint
374 (grid::foreign-pointer buffer)
375 (grid:dim0 buffer) timeout)))
376 (if (< bytes-written 0)
377 (error 'libusb-error :text "Bulk write failed.")
378 bytes-written)))
379
380 (defun usb-bulk-read (handle endpoint bytes-to-read timeout)
381 "Perform a bulk read request to the endpoint, which can be specified
382 by its address or pointer to the endpoint. Returns the buffer of
383 bytes read, which is of type vector-unsigned-byte-8."
384 (unless (integerp endpoint)
385 (setf endpoint (usb-endpoint-get-address endpoint)))
386 (let* ((buffer (grid:make-foreign-array
387 '(unsigned-byte 8)
388 :dimensions bytes-to-read))
389 (bytes-read
390 (usb-bulk-read* handle endpoint
391 (grid::foreign-pointer buffer)
392 bytes-to-read timeout)))
393 (if (< bytes-read 0)
394 (error 'libusb-error :text "Bulk read failed.")
a79faab @soemraws Some typos and range specifications fixed.
authored
395 (grid:slice buffer `((:range 0 ,(- bytes-read 1)))))))
0e92d26 @soemraws First commit
authored
396
397 ;;; Interrupt transfers
398 (defun usb-interrupt-write (handle endpoint buffer timeout)
399 "Perform an interrupt write request to the endpoint, which can
400 alternatively be specified by its address. Buffer should be a
401 foreign array of type vector-unsigned-byte-8. Returns number of
402 bytes written."
403 (unless (integerp endpoint)
404 (setf endpoint (usb-endpoint-get-address endpoint)))
405 (let* ((bytes-to-write (grid:dim0 buffer))
406 (bytes-written
407 (usb-interrupt-write* handle endpoint
408 (grid::foreign-pointer buffer)
409 bytes-to-write timeout)))
410 (if (< bytes-written 0)
411 (error 'libusb-error :text "Interrupt write failed.")
412 bytes-written)))
413
414 (defun usb-interrupt-read (handle endpoint bytes-to-read timeout)
415 "Perform an interrupt read request to the endpoint, which can be
416 specified by its address or pointer to the endpoint. Returns the
417 buffer of bytes read, which is of type vector-unsigned-byte-8."
418 (unless (integerp endpoint)
419 (setf endpoint (usb-endpoint-get-address endpoint)))
420 (let* ((buffer (grid:make-foreign-array
421 '(unsigned-byte 8)
422 :dimensions bytes-to-read))
423 (bytes-read
424 (usb-interrupt-read* handle endpoint
425 (grid::foreign-pointer buffer)
426 bytes-to-read timeout)))
427 (if (< bytes-read 0)
428 (error 'libusb-error :text "Interrupt read failed.")
a79faab @soemraws Some typos and range specifications fixed.
authored
429 (grid:slice buffer `((:range 0 ,(- bytes-read 1)))))))
0e92d26 @soemraws First commit
authored
430
431 (defun endpoint-in-p (endpoint)
432 "Check if an endpoint is an in endpoint (and thus can be read from)."
433 (unless (integerp endpoint)
434 (setf endpoint (usb-endpoint-get-address endpoint)))
435 (= (logand #x80 endpoint) #x80))
436
437 (defun endpoint-out-p (endpoint)
438 "Check if an endpoint is and out endpoint (and thus can be written to)."
439 (not (endpoint-in-p endpoint)))
Something went wrong with that request. Please try again.