linux-initrd: Copy all the script's closure to the initrd.

* gnu/system/linux-initrd.scm (expression->initrd): Remove calls to
  'imported-modules' and 'compiled-modules'.  Use 'gexp->script' with
  EXP.  Add the result to TO-COPY.  Make /init a symlink to that script,
  and copy its closure into the "contents" directory.  Add fake
  /proc/self/exe symlink.
* gnu/build/linux-boot.scm (load-linux-module*): Add comment about mmap.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Add "-m
  256".  This turns out to be needed for initrds containing things like
  e2fsck and several modules; with the default of 128 MiB, loading
  libahci.ko may fail with -1.

2 files changed, 62 insertions, 68 deletions

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 627d17bac2..b05cfc5bcd 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -68,85 +68,77 @@ initrd."
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
 
-  (define graph-files
-    (unfold-right zero?
-                  number->string
-                  1-
-                  (length to-copy)))
-
-  (mlet %store-monad ((source     (imported-modules modules))
-                      (compiled   (compiled-modules modules))
-                      (module-dir (flat-linux-module-directory linux
-                                                               linux-modules)))
+  (mlet* %store-monad ((init       (gexp->script "init" exp
+                                                 #:modules modules
+                                                 #:guile guile))
+                       (to-copy -> (cons init to-copy))
+                       (module-dir (flat-linux-module-directory linux
+                                                                linux-modules)))
+    (define graph-files
+      (unfold-right zero?
+                    number->string
+                    1-
+                    (length to-copy)))
+
     (define builder
       ;; TODO: Move most of this code to (gnu build linux-initrd).
       #~(begin
           (use-modules (gnu build linux-initrd)
                        (guix build utils)
                        (guix build store-copy)
-                       (ice-9 pretty-print)
-                       (ice-9 popen)
-                       (ice-9 match)
-                       (ice-9 ftw)
-                       (srfi srfi-26)
                        (system base compile)
                        (rnrs bytevectors)
                        ((system foreign) #:select (sizeof)))
 
-          (let ((modules #$source)
-                (gos     #$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))))
-            (mkdir #$output)
-            (mkdir "contents")
-
-            (with-directory-excursion "contents"
-              (copy-recursively #$guile ".")
-              (call-with-output-file "init"
-                (lambda (p)
-                  (format p "#!/bin/guile -ds~%!#~%" #$guile)
-                  (pretty-print '#$exp p)))
-              (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'.
+          (mkdir #$output)
+          (mkdir "contents")
+
+          (with-directory-excursion "contents"
+            ;; Copy Linux modules.
+            (mkdir "modules")
+            (copy-recursively #$module-dir "modules")
+
+            ;; Populate the initrd's store.
+            (with-directory-excursion ".."
+              (populate-store '#$graph-files "contents"))
+
+            ;; Make '/init'.
+            (symlink #$init "init")
+
+            ;; Compile it.
+            (let* ((init    (readlink "init"))
+                   (scm-dir (string-append "share/guile/" (effective-version)))
+                   (go-dir  (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
+                                    (effective-version)
+                                    (if (eq? (native-endianness) (endianness little))
+                                        "LE"
+                                        "BE")
+                                    (sizeof '*)
+                                    (effective-version)
+                                    (dirname init))))
               (mkdir-p go-dir)
-              (set! %load-path (cons modules %load-path))
-              (set! %load-compiled-path (cons gos %load-compiled-path))
-              (compile-file "init"
+              (compile-file init
                             #:opts %auto-compilation-options
-                            #:output-file (string-append go-dir "/init.go"))
-
-              ;; Copy Linux modules.
-              (mkdir "modules")
-              (copy-recursively #$module-dir "modules")
-
-              ;; Populate the initrd's store.
-              (with-directory-excursion ".."
-                (populate-store '#$graph-files "contents"))
-
-              ;; Reset the timestamps of all the files that will make it in the
-              ;; initrd.
-              (for-each (cut utime <> 0 0 0 0)
-                        (find-files "." ".*"))
-
-              (write-cpio-archive (string-append #$output "/initrd") "."
-                                  #:cpio (string-append #$cpio "/bin/cpio")
-                                  #:gzip (string-append #$gzip "/bin/gzip"))))))
+                            #:output-file (string-append go-dir "/"
+                                                         (basename init)
+                                                         ".go")))
+
+            ;; This hack allows Guile to find out where it is.  See
+            ;; 'guile-relocatable.patch'.
+            (mkdir-p "proc/self")
+            (symlink (string-append #$guile "/bin/guile") "proc/self/exe")
+            (readlink "proc/self/exe")
+
+            ;; Reset the timestamps of all the files that will make it in the
+            ;; initrd.
+            (for-each (lambda (file)
+                        (unless (eq? 'symlink (stat:type (lstat file)))
+                          (utime file 0 0 0 0)))
+                      (find-files "." ".*"))
+
+            (write-cpio-archive (string-append #$output "/initrd") "."
+                                #:cpio (string-append #$cpio "/bin/cpio")
+                                #:gzip (string-append #$gzip "/bin/gzip")))))
 
    (gexp->derivation name builder
                      #:modules '((guix build utils)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 205bf2cb19..4ee8dc5cf2 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -428,7 +428,9 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
   "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" \
   -serial stdio \
   -drive file=" #$image
-  ",if=virtio,cache=writeback,werror=report,readonly\n")
+  ",if=virtio,cache=writeback,werror=report,readonly \
+  -m 256
+\n")
              port)
             (chmod port #o555))))