From: "Ludovic Courtès" <ludo@gnu.org>
To: 59003@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#59003] [PATCH 3/7] linux-modules: Add 'load-pci-device-database'.
Date: Thu, 3 Nov 2022 20:19:31 +0100 [thread overview]
Message-ID: <20221103191935.16336-3-ludo@gnu.org> (raw)
In-Reply-To: <20221103191935.16336-1-ludo@gnu.org>
* gnu/build/linux-modules.scm (read-pci-device-database)
(load-pci-device-database): New procedures.
---
gnu/build/linux-modules.scm | 74 +++++++++++++++++++++++++++++++++++++
1 file changed, 74 insertions(+)
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 @@ (define-module (gnu build linux-modules)
storage-pci-device?
network-pci-device?
display-pci-device?
+ load-pci-device-database
current-module-debugging-port
@@ -488,6 +489,79 @@ (define class
(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:
--
2.38.0
next prev parent reply other threads:[~2022-11-03 19:21 UTC|newest]
Thread overview: 29+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-11-03 19:17 [bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices Ludovic Courtès
2022-11-03 19:19 ` [bug#59003] [PATCH 1/7] installer: Warn about hardware support after the welcome page Ludovic Courtès
2022-11-03 19:19 ` [bug#59003] [PATCH 2/7] linux-modules: Add support for listing PCI devices Ludovic Courtès
2022-11-05 15:21 ` pelzflorian (Florian Pelz)
2022-11-03 19:19 ` Ludovic Courtès [this message]
2022-11-03 19:19 ` [bug#59003] [PATCH 4/7] installer: Use 'current-guix' for extensions Ludovic Courtès
2022-11-05 9:09 ` pelzflorian (Florian Pelz)
2022-11-05 17:34 ` Ludovic Courtès
2022-11-03 19:19 ` [bug#59003] [PATCH 5/7] installer: Error page width is parameterized Ludovic Courtès
2022-11-03 19:19 ` [bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices Ludovic Courtès
2022-11-05 17:55 ` pelzflorian (Florian Pelz)
2022-11-06 11:20 ` Ludovic Courtès
2022-11-06 19:06 ` pelzflorian (Florian Pelz)
2022-11-05 20:51 ` [bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices Mathieu Othacehe
2022-11-05 21:11 ` Mathieu Othacehe
2022-11-09 20:26 ` Ludovic Courtès
2022-11-03 19:19 ` [bug#59003] [PATCH 7/7] installer: Remove unused variable Ludovic Courtès
2022-11-05 8:52 ` [bug#59003] [PATCH 1/7] installer: Warn about hardware support after the welcome page pelzflorian (Florian Pelz)
2022-11-05 18:02 ` pelzflorian (Florian Pelz)
2022-11-09 21:56 ` [bug#59003] [PATCH v2 0/6] [Installer] Warn about unsupported devices Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 1/6] installer: Warn about hardware support after the welcome page Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 2/6] linux-modules: Add support for listing PCI devices Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 3/6] linux-modules: Add 'load-pci-device-database' Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 4/6] installer: Use 'current-guix' for extensions Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 5/6] installer: Error page width is parameterized Ludovic Courtès
2022-11-09 21:56 ` [bug#59003] [PATCH v2 6/6] installer: Report known-unsupported PCI devices Ludovic Courtès
2022-11-11 11:08 ` pelzflorian (Florian Pelz)
2022-11-15 11:24 ` bug#59003: [PATCH 0/7] [Installer] Warn about unsupported devices Ludovic Courtès
2022-11-15 18:28 ` [bug#59003] " pelzflorian (Florian Pelz)
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20221103191935.16336-3-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=59003@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.