From b21a1c5a18e2e0f564812bd8a94a587d0234c68d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 4 Sep 2014 22:50:10 +0200
Subject: 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.
---
 gnu/system/linux-initrd.scm | 60 ++++++++++++++++++++++++++++-----------------
 1 file changed, 37 insertions(+), 23 deletions(-)

(limited to 'gnu/system/linux-initrd.scm')

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index bdee28c961..1108bec51d 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -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."
-- 
cgit v1.2.3