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:
parent
d2a1cf45f7
commit
fcd068e984
|
@ -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
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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 \
|
||||||
|
|
Loading…
Reference in New Issue