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