summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-03 14:36:21 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-15 12:16:42 +0100
commit655fb8feacfcb16da784ad88201663bb6fb566e4 (patch)
tree6754f59cee28e982ce02af6063a598b2a5f82450 /gnu/build
parent4f7ffb97a4c2f2ee7aa1c54c23a97e7c0447c08c (diff)
linux-modules: Add support for listing PCI devices.
* gnu/build/linux-modules.scm (<pci-device>): New record type. (pci-device-class-predicate, storage-pci-device?, network-pci-device?) (display-pci-device?, pci-devices?): New procedures.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/linux-modules.scm61
1 files changed, 60 insertions, 1 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 053720574b..09cf752bef 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;;
@@ -28,6 +28,7 @@
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 ftw)
@@ -50,6 +51,16 @@
load-linux-module*
load-linux-modules-from-directory
+ pci-devices
+ pci-device?
+ pci-device-vendor
+ pci-device-id
+ pci-device-class
+ pci-device-module-alias
+ storage-pci-device?
+ network-pci-device?
+ display-pci-device?
+
current-module-debugging-port
device-module-aliases
@@ -429,6 +440,54 @@ key such as 'MAJOR or 'DEVTYPE and each cdr is the corresponding value."
(line
(loop (cons (key=value->pair line) result))))))
+;; PCI device known to the Linux kernel.
+(define-immutable-record-type <pci-device>
+ (pci-device vendor device class module-alias)
+ pci-device?
+ (vendor pci-device-vendor) ;integer
+ (device pci-device-id) ;integer
+ (class pci-device-class) ;integer
+ (module-alias pci-device-module-alias)) ;string | #f
+
+(define (pci-device-class-predicate mask bits)
+ (lambda (device)
+ "Return true if DEVICE has the chosen class."
+ (= (logand mask (pci-device-class device)) bits)))
+
+(define storage-pci-device? ;"Mass storage controller" class
+ (pci-device-class-predicate #xff0000 #x010000))
+(define network-pci-device? ;"Network controller" class
+ (pci-device-class-predicate #xff0000 #x020000))
+(define display-pci-device? ;"Display controller" class
+ (pci-device-class-predicate #xff0000 #x030000))
+
+(define (pci-devices)
+ "Return the list of PCI devices of the system (<pci-device> records)."
+ (define (read-hex port)
+ (let ((line (read-line port)))
+ (and (string? line)
+ (string-prefix? "0x" line)
+ (string->number (string-drop line 2) 16))))
+
+ (filter-map (lambda (directory)
+ (define properties
+ (call-with-input-file (string-append directory "/uevent")
+ read-uevent))
+ (define vendor
+ (call-with-input-file (string-append directory "/vendor")
+ read-hex))
+ (define device
+ (call-with-input-file (string-append directory "/device")
+ read-hex))
+ (define class
+ (call-with-input-file (string-append directory "/class")
+ read-hex))
+
+ (pci-device vendor device class
+ (assq-ref properties 'MODALIAS)))
+ (find-files "/sys/bus/pci/devices"
+ #:stat lstat)))
+
(define (device-module-aliases device)
"Return the list of module aliases required by DEVICE, a /dev file name, as
in this example: