linux-initrd: Move Linux module tree flattening to another derivation.

* gnu/system/linux-initrd.scm (expression->initrd)[string->regexp]:
  Remove.
  Use 'flat-linux-module-directory'.  Remove the equivalent logic from
  'builder'.
  (flat-linux-module-directory): New procedure.
This commit is contained in:
Ludovic Courtès 2014-09-04 22:50:10 +02:00
parent 39c4563aea
commit b21a1c5a18
1 changed files with 37 additions and 23 deletions

View File

@ -68,12 +68,10 @@ initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
(define (string->regexp str)
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
(mlet* %store-monad ((source (imported-modules modules))
(compiled (compiled-modules modules)))
(mlet %store-monad ((source (imported-modules modules))
(compiled (compiled-modules modules))
(module-dir (flat-linux-module-directory linux
linux-modules)))
(define builder
;; TODO: Move most of this code to (gnu build linux-initrd).
#~(begin
@ -126,23 +124,8 @@ initrd."
#:output-file (string-append go-dir "/init.go"))
;; Copy Linux modules.
(let* ((linux #$linux)
(module-dir (and linux
(string-append linux "/lib/modules"))))
(mkdir "modules")
#$@(map (lambda (module)
#~(match (find-files module-dir
#$(string->regexp module))
((file)
(format #t "copying '~a'...~%" file)
(copy-file file (string-append "modules/"
#$module)))
(()
(error "module not found" #$module module-dir))
((_ ...)
(error "several modules by that name"
#$module module-dir))))
linux-modules))
(mkdir "modules")
(copy-recursively #$module-dir "modules")
(let ((store #$(string-append "." (%store-prefix)))
(to-copy '#$to-copy))
@ -169,6 +152,37 @@ initrd."
#:modules '((guix build utils)
(gnu build linux-initrd)))))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
MODULES and taken from LINUX."
(define build-exp
#~(begin
(use-modules (ice-9 match) (ice-9 regex)
(guix build utils))
(define (string->regexp str)
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
(define module-dir
(string-append #$linux "/lib/modules"))
(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)))
(gexp->derivation "linux-modules" build-exp
#:modules '((guix build utils))))
(define (file-system->spec fs)
"Return a list corresponding to file-system FS that can be passed to the
initrd code."