linux-modules: Factorize 'missing-modules'.
* gnu/build/linux-modules.scm (missing-modules): New procedure. * gnu/system/mapped-devices.scm (check-device-initrd-modules): Use it.
This commit is contained in:
parent
59e8044588
commit
4cd386afae
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -47,7 +47,8 @@
|
||||||
|
|
||||||
device-module-aliases
|
device-module-aliases
|
||||||
known-module-aliases
|
known-module-aliases
|
||||||
matching-modules))
|
matching-modules
|
||||||
|
missing-modules))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -463,4 +464,26 @@ ALIAS is a string like \"scsi:t-0x00\" as returned by
|
||||||
module)))
|
module)))
|
||||||
known-aliases))
|
known-aliases))
|
||||||
|
|
||||||
|
(define* (missing-modules device modules-provided)
|
||||||
|
"Assuming MODULES-PROVIDED lists kernel modules that are already
|
||||||
|
provided--e.g., in the initrd, return the list of missing kernel modules that
|
||||||
|
are required to access DEVICE."
|
||||||
|
(define aliases
|
||||||
|
;; Attempt to load 'modules.alias' from the current kernel, assuming we're
|
||||||
|
;; on Guix System, and assuming that corresponds to the kernel we'll be
|
||||||
|
;; installing.
|
||||||
|
(known-module-aliases))
|
||||||
|
|
||||||
|
(if aliases
|
||||||
|
(let* ((modules (delete-duplicates
|
||||||
|
(append-map (cut matching-modules <> aliases)
|
||||||
|
(device-module-aliases device))))
|
||||||
|
|
||||||
|
;; Module names (not file names) are supposed to use underscores
|
||||||
|
;; instead of hyphens. MODULES is a list of module names, whereas
|
||||||
|
;; LINUX-MODULES is file names without '.ko', so normalize them.
|
||||||
|
(provided (map file-name->module-name modules-provided)))
|
||||||
|
(remove (cut member <> provided) modules))
|
||||||
|
'()))
|
||||||
|
|
||||||
;;; linux-modules.scm ends here
|
;;; linux-modules.scm ends here
|
||||||
|
|
|
@ -32,8 +32,7 @@
|
||||||
#:use-module (gnu system uuid)
|
#:use-module (gnu system uuid)
|
||||||
#:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
|
#:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
|
||||||
#:autoload (gnu build linux-modules)
|
#:autoload (gnu build linux-modules)
|
||||||
(device-module-aliases matching-modules known-module-aliases
|
(missing-modules)
|
||||||
normalize-module-name file-name->module-name)
|
|
||||||
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
|
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
|
||||||
#:autoload (gnu packages linux) (mdadm-static)
|
#:autoload (gnu packages linux) (mdadm-static)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -118,37 +117,27 @@
|
||||||
(define (check-device-initrd-modules device linux-modules location)
|
(define (check-device-initrd-modules device linux-modules location)
|
||||||
"Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
|
"Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate.
|
||||||
DEVICE must be a \"/dev\" file name."
|
DEVICE must be a \"/dev\" file name."
|
||||||
(define aliases
|
(define missing
|
||||||
;; Attempt to load 'modules.alias' from the current kernel, assuming we're
|
;; Attempt to determine missing modules.
|
||||||
;; on Guix System, and assuming that corresponds to the kernel we'll be
|
|
||||||
;; installing. Skip the whole thing if that file cannot be read.
|
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(known-module-aliases))
|
(missing-modules device linux-modules))
|
||||||
(const #f)))
|
|
||||||
|
|
||||||
(when aliases
|
;; If we can't do that (e.g., EPERM), skip the whole thing.
|
||||||
(let* ((modules (delete-duplicates
|
(const '())))
|
||||||
(append-map (cut matching-modules <> aliases)
|
|
||||||
(device-module-aliases device))))
|
|
||||||
|
|
||||||
;; Module names (not file names) are supposed to use underscores
|
(unless (null? missing)
|
||||||
;; instead of hyphens. MODULES is a list of module names, whereas
|
;; Note: What we suggest here is a list of module names (e.g.,
|
||||||
;; LINUX-MODULES is file names without '.ko', so normalize them.
|
;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is
|
||||||
(provided (map file-name->module-name linux-modules))
|
;; OK because we have machinery that accepts both the hyphen and the
|
||||||
(missing (remove (cut member <> provided) modules)))
|
;; underscore version.
|
||||||
(unless (null? missing)
|
(raise (condition
|
||||||
;; Note: What we suggest here is a list of module names (e.g.,
|
(&message
|
||||||
;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is
|
(message (format #f (G_ "you may need these modules \
|
||||||
;; OK because we have machinery that accepts both the hyphen and the
|
|
||||||
;; underscore version.
|
|
||||||
(raise (condition
|
|
||||||
(&message
|
|
||||||
(message (format #f (G_ "you may need these modules \
|
|
||||||
in the initrd for ~a:~{ ~a~}")
|
in the initrd for ~a:~{ ~a~}")
|
||||||
device missing)))
|
device missing)))
|
||||||
(&fix-hint
|
(&fix-hint
|
||||||
(hint (format #f (G_ "Try adding them to the
|
(hint (format #f (G_ "Try adding them to the
|
||||||
@code{initrd-modules} field of your @code{operating-system} declaration, along
|
@code{initrd-modules} field of your @code{operating-system} declaration, along
|
||||||
these lines:
|
these lines:
|
||||||
|
|
||||||
|
@ -161,9 +150,9 @@ these lines:
|
||||||
|
|
||||||
If you think this diagnostic is inaccurate, use the @option{--skip-checks}
|
If you think this diagnostic is inaccurate, use the @option{--skip-checks}
|
||||||
option of @command{guix system}.\n")
|
option of @command{guix system}.\n")
|
||||||
missing)))
|
missing)))
|
||||||
(&error-location
|
(&error-location
|
||||||
(location (source-properties->location location)))))))))
|
(location (source-properties->location location)))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Reference in New Issue