;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2018 Ricardo Wurmus ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2016, 2024 Efraim Flashner ;;; Copyright © 2017 Chris Marusich ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2019, 2022, 2023 Maxim Cournoyer ;;; Copyright © 2019, 2021 Guillaume Le Vaillant ;;; Copyright © 2020 Prafulla Giri ;;; Copyright © 2020 Christopher Lam ;;; Copyright © 2023 gemmaro ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version.
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; 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>
;;; Copyright © 2023 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu build linux-modules)
  #:use-module (guix elf)
  #:use-module (guix glob)
  #:use-module (guix build syscalls)
  #:use-module ((guix build utils) #:select (find-files invoke))
  #:use-module (guix build union)
  #:autoload   (zlib) (call-with-gzip-input-port)
  #:autoload   (zstd) (call-with-zstd-input-port)
  #: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)
  #:use-module (ice-9 vlist)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:autoload   (ice-9 pretty-print) (pretty-print)
  #:export (dot-ko
            ensure-dot-ko
            module-formal-name
            module-aliases
            module-dependencies
            module-soft-dependencies
            normalize-module-name
            file-name->module-name
            find-module-file
            recursive-module-dependencies
            modules-loaded
            module-loaded?
            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
            known-module-aliases
            matching-modules
            missing-modules

            write-module-name-database
            write-module-alias-database
            write-module-device-database

            make-linux-module-directory))

;;; Commentary:
;;;
;;; Tools to deal with Linux kernel modules.
;;;
;;; Code:

(define current-module-debugging-port
  (make-parameter (%make-void-port "w")))

(define (section-contents elf section)
  "Return the contents of SECTION in ELF as a bytevector."
  (let ((contents (make-bytevector (elf-section-size section))))
    (bytevector-copy! (elf-bytes elf) (elf-section-offset section)
                      contents 0
                      (elf-section-size section))
    contents))

(define %not-nul
  (char-set-complement (char-set #\nul)))

(define (nul-separated-string->list str)
  "Split STR at occurrences of the NUL character and return the resulting
string list."
  (string-tokenize str %not-nul))

(define (key=value->pair str)
  "Assuming STR has the form \"KEY=VALUE\", return a pair like (KEY
. \"VALUE\")."
  (let ((= (string-index str #\=)))
    (cons (string->symbol (string-take str =))
          (string-drop str (+ 1 =)))))

;; Matches kernel modules, without compression, with GZIP, XZ or ZSTD
;; compression.
(define module-regex "\\.ko(\\.gz|\\.xz|\\.zst)?$")

(define (modinfo-section-contents file)
  "Return the contents of the '.modinfo' section of FILE as a list of
key/value pairs.."
  (define (decompress-file decompressor file)
    (let ((port (open-file file "r0")))
      (dynamic-wind
        (lambda ()
          #t)
        (lambda ()
          (decompressor port get-bytevector-all))
        (lambda ()
          (close-port port)))))

  (define (get-bytevector file)
    (cond
     ((string-suffix? ".ko.gz" file)
      (decompress-file call-with-gzip-input-port file))
     ((string-suffix? ".ko.zst" file)
      (decompress-file call-with-zstd-input-port file))
     (else
      (call-with-input-file file get-bytevector-all))))

  (let* ((bv      (get-bytevector file))
         (elf     (parse-elf bv))
         (section (elf-section-by-name elf ".modinfo"))
         (modinfo (section-contents elf section)))
    (map key=value->pair
         (nul-separated-string->list (utf8->string modinfo)))))

(define %not-comma
  (char-set-complement (char-set #\,)))

(define (module-formal-name file)
  "Return the module name of FILE as it appears in its info section.  Usually
the module name is the same as the base name of FILE, modulo hyphens and minus
the \".ko[.gz|.xz]\" extension."
  (match (assq 'name (modinfo-section-contents file))
    (('name . name) name)
    (#f #f)))

(define (module-dependencies file)
  "Return the list of modules that FILE depends on.  The returned list
contains module names, not actual file names."
  (let ((info (modinfo-section-contents file)))
    (match (assq 'depends info)
      (('depends . what)
       (string-tokenize what %not-comma)))))

(define not-softdep-whitespace
  (char-set-complement (char-set #\space #\tab)))

(define (module-soft-dependencies file)
  "Return the list of modules that can be preloaded, and then the list of
modules that can be postloaded, of the soft dependencies of module FILE."
  ;; TEXT: "pre: baz blubb foo post: bax bar"
  (define (parse-softdep text)
    (let loop ((value '())
               (tokens (string-tokenize text not-softdep-whitespace))
               (section #f))
      (match tokens
       ((token rest ...)
        (if (string=? (string-take-right token 1) ":") ; section
            (loop value rest (string-trim-both (string-drop-right token 1)))
            (loop (cons (cons section token) value) rest section)))
       (()
        value))))

  ;; Note: Multiple 'softdep sections are allowed.
  (let* ((info (modinfo-section-contents file))
         (entries (concatenate
                   (filter-map (match-lambda
                                (('softdep . value)
                                 (parse-softdep value))
                                (_ #f))
                               (modinfo-section-contents file)))))
    (let-values (((pres posts)
                  (partition (match-lambda
                              (("pre" . _) #t)
                              (("post" . _) #f))
                             entries)))
      (values (map (match-lambda
                    ((_ . value) value))
                   pres)
              (map (match-lambda
                    ((_ . value) value))
                   posts)))))

(define (module-aliases file)
  "Return the list of aliases of module FILE."
  (let ((info (modinfo-section-contents file)))
    (filter-map (match-lambda
                 (('alias . value)
                  value)
                 (_ #f))
                (modinfo-section-contents file))))

(define (strip-extension filename)
  (let ((extension (string-index filename #\.)))
    (if extension
        (string-take filename extension)
        filename)))

(define* (dot-ko name #:optional compression)
  (let ((suffix (match compression
                  ('xz   ".ko.xz")
                  ('gzip ".ko.gz")
                  ('zstd ".ko.zst")
                  (else  ".ko"))))
    (string-append name suffix)))

(define (ensure-dot-ko name compression)
  "Return NAME with a '.ko[.gz|.xz|.zst]' suffix appended, unless it already has
it."
  (if (string-contains name ".ko")
      name
      (dot-ko name compression)))

(define (normalize-module-name module)
  "Return the \"canonical\" name for MODULE, replacing hyphens with
underscores."
  ;; See 'modname_normalize' in libkmod.
  (string-map (lambda (chr)
                (case chr
                  ((#\-) #\_)
                  (else chr)))
              module))

(define (file-name->module-name file)
  "Return the module name corresponding to FILE, stripping the trailing
'.ko[.gz|.xz|.zst]' and normalizing it."
  (normalize-module-name (strip-extension (basename file))))

(define (find-module-file directory module)
  "Lookup module NAME under DIRECTORY, and return its absolute file name.
NAME can be a file name with or without '.ko', or it can be a module name.
Raise an error if it could not be found.

Module names can differ from file names in interesting ways; for instance,
module names usually (always?) use underscores as the inter-word separator,
whereas file names often, but not always, use hyphens.  Examples:
\"usb-storage.ko\", \"serpent_generic.ko\"."
  (define names
    ;; List of possible file names.  XXX: It would of course be cleaner to
    ;; have a database that maps module names to file names and vice versa,
    ;; but everyone seems to be doing hacks like this one.  Oh well!
    (delete-duplicates
     (list module
           (normalize-module-name module)
           (string-map (lambda (chr) ;converse of 'normalize-module-name'
                         (case chr
                           ((#\_) #\-)
                           (else chr)))
                       module))))

  (match (find-files directory
                     (lambda (file stat)
                       (member (strip-extension
                                (basename file)) names)))
    ((file)
     file)
    (()
     (error "kernel module not found" module directory))
    ((_ ...)
     (error "several modules by that name" module directory))))

(define* (recursive-module-dependencies files
                                        #:key (lookup-module dot-ko))
  "Return the topologically-sorted list of file names of the modules depended
on by FILES, recursively.  File names of modules are determined by applying
LOOKUP-MODULE to the module name."
  (let loop ((files   files)
             (result  '())
             (visited vlist-null))
    (match files
      (()
       (delete-duplicates (reverse result)))
      ((head . tail)
       (let* ((visited? (vhash-assoc head visited))
              (deps     (if visited?
                            '()
                            (map lookup-module (module-dependencies head))))
              (visited  (if visited?
                            visited
                            (vhash-cons head #t visited))))
         (loop (append deps tail)
               (append result deps) visited))))))

(define %not-newline
  (char-set-complement (char-set #\newline)))

(define (modules-loaded)
  "Return the list of names of currently loaded Linux modules."
  (let* ((contents (call-with-input-file "/proc/modules"
                     get-string-all))