diff options
| -rw-r--r-- | gnu/build/linux-boot.scm | 1 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 126 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 4 |
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)))) |