mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
linux-initrd: Copy modules and their dependencies to the initrd.
* gnu/system/linux-initrd.scm (flat-linux-module-directory)[build-exp]: Add 'lookup' procedure. Use 'recursive-module-dependencies' to compute the list of modules to copy. Adjust #:modules parameter.
This commit is contained in:
parent
fcaa5f44a1
commit
600c285b63
1 changed files with 28 additions and 12 deletions
|
@ -92,7 +92,9 @@ (define (flat-linux-module-directory linux modules)
|
|||
(define build-exp
|
||||
#~(begin
|
||||
(use-modules (ice-9 match) (ice-9 regex)
|
||||
(guix build utils))
|
||||
(srfi srfi-1)
|
||||
(guix build utils)
|
||||
(gnu build linux-modules))
|
||||
|
||||
(define (string->regexp str)
|
||||
;; Return a regexp that matches STR exactly.
|
||||
|
@ -101,21 +103,35 @@ (define (string->regexp str)
|
|||
(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)))
|
||||
(append modules
|
||||
(recursive-module-dependencies modules
|
||||
#:lookup-module lookup))))
|
||||
|
||||
(mkdir #$output)
|
||||
(for-each (lambda (module)
|
||||
(match (find-files module-dir (string->regexp module))
|
||||
((file)
|
||||
(format #t "copying '~a'...~%" file)
|
||||
(copy-file file (string-append #$output "/" module)))
|
||||
(()
|
||||
(error "module not found" module module-dir))
|
||||
((_ ...)
|
||||
(error "several modules by that name"
|
||||
module module-dir))))
|
||||
'#$modules)))
|
||||
(format #t "copying '~a'...~%" module)
|
||||
(copy-file module
|
||||
(string-append #$output "/"
|
||||
(basename module))))
|
||||
(delete-duplicates modules))))
|
||||
|
||||
(gexp->derivation "linux-modules" build-exp
|
||||
#:modules '((guix build utils))))
|
||||
#:modules '((guix build utils)
|
||||
(guix elf)
|
||||
(gnu build linux-modules))))
|
||||
|
||||
(define (file-system->spec fs)
|
||||
"Return a list corresponding to file-system FS that can be passed to the
|
||||
|
|
Loading…
Reference in a new issue