aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/linux-boot.scm1
-rw-r--r--gnu/system/linux-initrd.scm126
-rw-r--r--gnu/system/vm.scm4
3 files changed, 63 insertions, 68 deletions
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 21ee58ad50..1312da6bbd 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -221,6 +221,7 @@ networking values.) Return #t if INTERFACE is up, #f otherwise."
(define (load-linux-module* file)
"Load Linux module from FILE, the name of a `.ko' file."
(define (slurp module)
+ ;; TODO: Use 'mmap' to reduce memory usage.
(call-with-input-file file get-bytevector-all))
(load-linux-module (slurp file)))
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))))