aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/linux-initrd.scm26
-rw-r--r--gnu/system/mapped-devices.scm29
2 files changed, 22 insertions, 33 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index d73ebfd8d3..a5a111908f 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -108,34 +108,18 @@ the derivations referenced by EXP are automatically copied to the initrd."
MODULES and taken from LINUX."
(define build-exp
(with-imported-modules (source-module-closure
- '((guix build utils)
- (gnu build linux-modules)))
+ '((gnu build linux-modules)))
#~(begin
- (use-modules (ice-9 match) (ice-9 regex)
+ (use-modules (gnu build linux-modules)
(srfi srfi-1)
- (guix build utils)
- (gnu build linux-modules))
-
- (define (string->regexp str)
- ;; Return a regexp that matches STR exactly.
- (string-append "^" (regexp-quote str) "$"))
+ (srfi srfi-26))
(define module-dir
(string-append #$linux "/lib/modules"))
- (define (lookup module)
- (let ((name (ensure-dot-ko module)))
- (match (find-files module-dir (string->regexp name))
- ((file)
- file)
- (()
- (error "module not found" name module-dir))
- ((_ ...)
- (error "several modules by that name"
- name module-dir)))))
-
(define modules
- (let ((modules (map lookup '#$modules)))
+ (let* ((lookup (cut find-module-file module-dir <>))
+ (modules (map lookup '#$modules)))
(append modules
(recursive-module-dependencies modules
#:lookup-module lookup))))
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index c452bdd894..af73dc608c 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -21,7 +21,7 @@
(define-module (gnu system mapped-devices)
#:use-module (guix gexp)
#:use-module (guix records)
- #:use-module (guix modules)
+ #:use-module ((guix modules) #:hide (file-name->module-name))
#:use-module (guix i18n)
#:use-module ((guix utils)
#:select (source-properties->location
@@ -33,7 +33,7 @@
#:autoload (gnu build file-systems) (find-partition-by-luks-uuid)
#:autoload (gnu build linux-modules)
(device-module-aliases matching-modules known-module-aliases
- normalize-module-name)
+ normalize-module-name file-name->module-name)
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
#:autoload (gnu packages linux) (mdadm-static)
#:use-module (srfi srfi-1)
@@ -128,20 +128,25 @@ DEVICE must be a \"/dev\" file name."
(const #f)))
(when aliases
- (let ((modules (delete-duplicates
- (append-map (cut matching-modules <> aliases)
- (device-module-aliases device))))
+ (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 normalize-module-name linux-modules)))
- (unless (every (cut member <> provided) modules)
+ ;; 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 linux-modules))
+ (missing (remove (cut member <> provided) modules)))
+ (unless (null? missing)
+ ;; Note: What we suggest here is a list of module names (e.g.,
+ ;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is
+ ;; 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~}")
- device modules)))
+ device missing)))
(&fix-hint
(hint (format #f (G_ "Try adding them to the
@code{initrd-modules} field of your @code{operating-system} declaration, along
@@ -153,7 +158,7 @@ these lines:
(initrd-modules (append (list~{ ~s~})
%base-initrd-modules)))
@end example\n")
- modules)))
+ missing)))
(&error-location
(location (source-properties->location location)))))))))