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.
This commit is contained in:
Ludovic Courtès 2018-07-29 18:31:42 +02:00
parent d2a1cf45f7
commit fcd068e984
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 44 additions and 21 deletions

View File

@ -21,6 +21,7 @@
#:use-module (guix elf) #:use-module (guix elf)
#:use-module (guix glob) #:use-module (guix glob)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module ((guix build utils) #:select (find-files))
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -34,6 +35,7 @@
module-dependencies module-dependencies
normalize-module-name normalize-module-name
file-name->module-name file-name->module-name
find-module-file
recursive-module-dependencies recursive-module-dependencies
modules-loaded modules-loaded
module-loaded? module-loaded?
@ -131,6 +133,39 @@ underscores."
and normalizing it." and normalizing it."
(normalize-module-name (basename file ".ko"))) (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 (define* (recursive-module-dependencies files
#:key (lookup-module dot-ko)) #:key (lookup-module dot-ko))
"Return the topologically-sorted list of file names of the modules depended "Return the topologically-sorted list of file names of the modules depended

View File

@ -108,34 +108,18 @@ the derivations referenced by EXP are automatically copied to the initrd."
MODULES and taken from LINUX." MODULES and taken from LINUX."
(define build-exp (define build-exp
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((guix build utils) '((gnu build linux-modules)))
(gnu build linux-modules)))
#~(begin #~(begin
(use-modules (ice-9 match) (ice-9 regex) (use-modules (gnu build linux-modules)
(srfi srfi-1) (srfi srfi-1)
(guix build utils) (srfi srfi-26))
(gnu build linux-modules))
(define (string->regexp str)
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
(define module-dir (define module-dir
(string-append #$linux "/lib/modules")) (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 (define modules
(let ((modules (map lookup '#$modules))) (let* ((lookup (cut find-module-file module-dir <>))
(modules (map lookup '#$modules)))
(append modules (append modules
(recursive-module-dependencies modules (recursive-module-dependencies modules
#:lookup-module lookup)))) #:lookup-module lookup))))

View File

@ -137,6 +137,10 @@ DEVICE must be a \"/dev\" file name."
;; LINUX-MODULES is file names without '.ko', so normalize them. ;; LINUX-MODULES is file names without '.ko', so normalize them.
(provided (map file-name->module-name linux-modules))) (provided (map file-name->module-name linux-modules)))
(unless (every (cut member <> provided) 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 (raise (condition
(&message (&message
(message (format #f (G_ "you may need these modules \ (message (format #f (G_ "you may need these modules \