diff options
Diffstat (limited to 'gnu/build/linux-modules.scm')
| -rw-r--r-- | gnu/build/linux-modules.scm | 135 |
1 files changed, 134 insertions, 1 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index 053720574b..3b1f512663 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,17 @@ 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? + load-pci-device-database + current-module-debugging-port device-module-aliases @@ -429,6 +441,127 @@ 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 (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: |