summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-03 14:37:45 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-15 12:16:43 +0100
commitafbd4d8470ad2e0b3bd5dd84b983bb343b4451f9 (patch)
tree8cce77f4d706c9d0a28f3af59f40f287439970a4 /gnu/build
parent655fb8feacfcb16da784ad88201663bb6fb566e4 (diff)
linux-modules: Add 'load-pci-device-database'.
* gnu/build/linux-modules.scm (read-pci-device-database) (load-pci-device-database): New procedures.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/linux-modules.scm74
1 files changed, 74 insertions, 0 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 09cf752bef..3b1f512663 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -60,6 +60,7 @@
storage-pci-device?
network-pci-device?
display-pci-device?
+ load-pci-device-database
current-module-debugging-port
@@ -488,6 +489,79 @@ key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value."
(find-files "/sys/bus/pci/devices"
#:stat lstat)))
+(define (read-pci-device-database port)
+ "Parse the 'pci.ids' database that ships with the pciutils package and is
+maintained at <https://pci-ids.ucw.cz/>."
+ (define (comment? str)
+ (string-prefix? "#" (string-trim str)))
+ (define (blank? str)
+ (string-null? (string-trim-both str)))
+ (define (device? str)
+ (eqv? #\tab (string-ref str 0)))
+ (define (subvendor? str)
+ (string-prefix? "\t\t" str))
+ (define (class? str)
+ (string-prefix? "C " str))
+ (define (parse-id-line str)
+ (let* ((str (string-trim-both str))
+ (space (string-index str char-set:whitespace)))
+ (values (string->number (string-take str space) 16)
+ (string-trim (string-drop str (+ 1 space))))))
+ (define (finish vendor vendor-id devices table)
+ (fold (lambda (device table)
+ (match device
+ ((device-id . name)
+ (vhash-consv (logior (ash vendor-id 16) device-id)
+ (cons vendor name)
+ table))))
+ table
+ devices))
+
+ (let loop ((table vlist-null)
+ (vendor-id #f)
+ (vendor #f)
+ (devices '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (let ((table (if (and vendor vendor-id)
+ (finish vendor vendor-id devices table)
+ table)))
+ (lambda (vendor device)
+ (match (vhash-assv (logior (ash vendor 16) device) table)
+ (#f
+ (values #f #f))
+ ((_ . (vendor . name))
+ (values vendor name))))))
+ ((? comment?)
+ (loop table vendor-id vendor devices))
+ ((? blank?)
+ (loop table vendor-id vendor devices))
+ ((? subvendor?) ;currently ignored
+ (loop table vendor-id vendor devices))
+ ((? class?) ;currently ignored
+ (loop table vendor-id vendor devices))
+ ((? device? line)
+ (let-values (((id name) (parse-id-line line)))
+ (loop table vendor-id vendor
+ (if (and vendor-id vendor) ;class or device?
+ (alist-cons id name devices)
+ devices))))
+ (line
+ (let ((table (if (and vendor vendor-id)
+ (finish vendor vendor-id devices table)
+ table)))
+ (let-values (((vendor-id vendor) (parse-id-line line)))
+ (loop table vendor-id vendor '())))))))
+
+(define (load-pci-device-database file)
+ "Read the 'pci.ids' database at FILE (get it from the pciutils package or
+from <https://pci-ids.ucw.cz/>) and return a lookup procedure that takes a PCI
+vendor ID and a device ID (two integers) and returns the vendor name and
+device name as two values."
+ (let ((port (open-file file "r0")))
+ (call-with-gzip-input-port port
+ read-pci-device-database)))
+
(define (device-module-aliases device)
"Return the list of module aliases required by DEVICE, a /dev file name, as
in this example: