gnu: linux-initrd: Allow Guile modules to be embedded in the initrd.

* gnu/packages/linux-initrd.scm (raw-build-system): New macro.
  (module-package, compiled-module-package): New procedures.
  (expression->initrd): Add `modules' keyword parameter.
  Add "modules" and "modules/compiled" inputs; copy them onto the
  initrd.
* guix/derivations.scm (imported-modules, compiled-modules): Publicize.

1 files changed, 83 insertions, 19 deletions

diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
index 348e411d07..db54699ac1 100644
--- a/gnu/packages/linux-initrd.scm
+++ b/gnu/packages/linux-initrd.scm
@@ -19,10 +19,14 @@
 (define-module (gnu packages linux-initrd)
   #:use-module (guix utils)
   #:use-module (guix licenses)
+  #:use-module (guix build-system)
+  #:use-module ((guix derivations)
+                #:select (imported-modules compiled-modules %guile-for-build))
   #:use-module (gnu packages)
   #:use-module (gnu packages cpio)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages guile)
   #:use-module ((gnu packages make-bootstrap)
                 #:select (%guile-static-stripped))
   #:use-module (guix packages)
@@ -38,6 +42,49 @@
 ;;; Code:
 
 
+(define-syntax-rule (raw-build-system (store system name inputs) body ...)
+  "Lift BODY to a package build system."
+  ;; TODO: Generalize.
+  (build-system
+   (name "raw")
+   (description "Raw build system")
+   (build (lambda* (store name source inputs #:key system #:allow-other-keys)
+            (parameterize ((%guile-for-build (package-derivation store
+                                                                 guile-2.0)))
+              body ...)))))
+
+(define (module-package modules)
+  "Return a package that contains all of MODULES, a list of Guile module
+names."
+  (package
+    (name "guile-modules")
+    (version "0")
+    (source #f)
+    (build-system (raw-build-system (store system name inputs)
+                    (imported-modules store modules
+                                      #:name name
+                                      #:system system)))
+    (synopsis "Set of Guile modules")
+    (description synopsis)
+    (license gpl3+)
+    (home-page "http://www.gnu.org/software/guix/")))
+
+(define (compiled-module-package modules)
+  "Return a package that contains the .go files corresponding to MODULES, a
+list of Guile module names."
+  (package
+    (name "guile-compiled-modules")
+    (version "0")
+    (source #f)
+    (build-system (raw-build-system (store system name inputs)
+                    (compiled-modules store modules
+                                      #:name name
+                                      #:system system)))
+    (synopsis "Set of compiled Guile modules")
+    (description synopsis)
+    (license gpl3+)
+    (home-page "http://www.gnu.org/software/guix/")))
+
 (define* (expression->initrd exp
                              #:key
                              (guile %guile-static-stripped)
@@ -45,12 +92,13 @@
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system))
+                             (modules '())
                              (linux #f)
                              (linux-modules '()))
   "Return a package that contains a Linux initrd (a gzipped cpio archive)
 containing GUILE and that evaluates EXP upon booting.  LINUX-MODULES is a list
-of `.ko' file names to be copied from LINUX into the initrd."
-  ;; TODO: Add a `modules' parameter.
+of `.ko' file names to be copied from LINUX into the initrd.  MODULES is a
+list of Guile module names to be embedded in the initrd."
 
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
@@ -67,12 +115,22 @@ of `.ko' file names to be copied from LINUX into the initrd."
                     (rnrs bytevectors)
                     ((system foreign) #:select (sizeof)))
 
-       (let ((guile (assoc-ref %build-inputs "guile"))
-             (cpio  (string-append (assoc-ref %build-inputs "cpio")
-                                   "/bin/cpio"))
-             (gzip  (string-append (assoc-ref %build-inputs "gzip")
-                                   "/bin/gzip"))
-             (out   (assoc-ref %outputs "out")))
+       (let ((guile   (assoc-ref %build-inputs "guile"))
+             (cpio    (string-append (assoc-ref %build-inputs "cpio")
+                                     "/bin/cpio"))
+             (gzip    (string-append (assoc-ref %build-inputs "gzip")
+                                     "/bin/gzip"))
+             (modules (assoc-ref %build-inputs "modules"))
+             (gos     (assoc-ref %build-inputs "modules/compiled"))
+             (scm-dir (string-append "share/guile/" (effective-version)))
+             (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a"
+                              (effective-version)
+                              (if (eq? (native-endianness) (endianness little))
+                                  "LE"
+                                  "BE")
+                              (sizeof '*)
+                              (effective-version)))
+             (out     (assoc-ref %outputs "out")))
          (mkdir out)
          (mkdir "contents")
          (with-directory-excursion "contents"
@@ -84,19 +142,23 @@ of `.ko' file names to be copied from LINUX into the initrd."
            (chmod "init" #o555)
            (chmod "bin/guile" #o555)
 
+           ;; Copy Guile modules.
+           (chmod scm-dir #o777)
+           (copy-recursively modules scm-dir
+                             #:follow-symlinks? #t)
+           (copy-recursively gos (string-append "lib/guile/"
+                                                (effective-version) "/ccache")
+                             #:follow-symlinks? #t)
+
            ;; Compile `init'.
-           (let ((go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
-                                 (effective-version)
-                                 (if (eq? (native-endianness) (endianness little))
-                                     "LE"
-                                     "BE")
-                                 (sizeof '*)
-                                 (effective-version))))
-             (mkdir-p go-dir)
-             (compile-file "init"
-                           #:opts %auto-compilation-options
-                           #:output-file (string-append go-dir "/init.go")))
+           (mkdir-p go-dir)
+           (set! %load-path (cons modules %load-path))
+           (set! %load-compiled-path (cons gos %load-compiled-path))
+           (compile-file "init"
+                         #:opts %auto-compilation-options
+                         #:output-file (string-append go-dir "/init.go"))
 
+           ;; Copy Linux modules.
            (let* ((linux      (assoc-ref %build-inputs "linux"))
                   (module-dir (and linux
                                    (string-append linux "/lib/modules"))))
@@ -161,6 +223,8 @@ of `.ko' file names to be copied from LINUX into the initrd."
       (inputs `(("guile" ,guile)
                 ("cpio" ,cpio)
                 ("gzip" ,gzip)
+                ("modules" ,(module-package modules))
+                ("modules/compiled" ,(compiled-module-package modules))
                 ,@(if linux
                       `(("linux" ,linux))
                       '())))