summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-07-29 18:31:42 +0200
committerLudovic Courtès <ludo@gnu.org>2018-07-29 18:50:28 +0200
commitfcd068e984078ab74c6842af2525bf88096cd262 (patch)
tree01a18470cb88a13a6c9d2dbc33cd098dfa93c083 /gnu
parentd2a1cf45f74f4be67bd51068fc531a1b8ae54536 (diff)
linux-initrd: Try several file names when looking up modules.
Fixes <https://bugs.gnu.org/31714>. Reported by Tonton <tonton@riseup.net>. * gnu/build/linux-modules.scm (find-module-file): New procedure. * gnu/system/linux-initrd.scm (flat-linux-module-directory)[build-exp]: Remove 'lookup' procedure and use 'find-module-file' instead. * gnu/system/mapped-devices.scm (check-device-initrd-modules): Add comment.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/linux-modules.scm35
-rw-r--r--gnu/system/linux-initrd.scm26
-rw-r--r--gnu/system/mapped-devices.scm4
3 files changed, 44 insertions, 21 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index b06c576441..9c8761527a 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -21,6 +21,7 @@
#:use-module (guix elf)
#:use-module (guix glob)
#:use-module (guix build syscalls)
+ #:use-module ((guix build utils) #:select (find-files))
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
@@ -34,6 +35,7 @@
module-dependencies
normalize-module-name
file-name->module-name
+ find-module-file
recursive-module-dependencies
modules-loaded
module-loaded?
@@ -131,6 +133,39 @@ underscores."
and normalizing it."
(normalize-module-name (basename file ".ko")))
+(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.
+Return #f 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!
+ (map ensure-dot-ko
+ (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 (basename file) names)))
+ ((file)
+ file)
+ (()
+ #f)
+ ((_ ...)
+ (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
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 aec49322e7..384b1aaf7d 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -137,6 +137,10 @@ DEVICE must be a \"/dev\" file name."
;; LINUX-MODULES is file names without '.ko', so normalize them.
(provided (map file-name->module-name linux-modules)))
(unless (every (cut member <> provided) modules)
+ ;; 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 \