diff options
| -rw-r--r-- | gnu/system/linux-initrd.scm | 9 | ||||
| -rw-r--r-- | guix/build/linux-initrd.scm | 35 |
2 files changed, 40 insertions, 4 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1cc1d3b147..9520473d01 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -191,6 +191,7 @@ list of Guile module names to be embedded in the initrd." (define* (qemu-initrd #:key guile-modules-in-chroot? + volatile-root? (mounts `((cifs "/store" ,(%store-prefix)) (cifs "/xchg" "/xchg")))) "Return a monadic derivation that builds an initrd for use in a QEMU guest @@ -202,7 +203,10 @@ be mounted atop the root file system, where each item has the form: When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in the new root. This is necessary is the file specified as '--load' needs access to these modules (which is the case if it wants to even just print an -exception and backtrace!)." +exception and backtrace!). + +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost." (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4.ko" "ecb.ko" "cifs.ko")) @@ -229,7 +233,8 @@ exception and backtrace!)." (boot-system #:mounts ',mounts #:linux-modules ',linux-modules #:qemu-guest-networking? #t - #:guile-modules-in-chroot? ',guile-modules-in-chroot?)) + #:guile-modules-in-chroot? ',guile-modules-in-chroot? + #:volatile-root? ',volatile-root?)) #:name "qemu-initrd" #:modules '((guix build utils) (guix build linux-initrd)) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 7b22354f70..d317f850f2 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -24,6 +24,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) + #:use-module (ice-9 ftw) #:use-module (guix build utils) #:export (mount-essential-file-systems linux-command-line @@ -179,6 +180,7 @@ the last argument of `mknod'." (linux-modules '()) qemu-guest-networking? guile-modules-in-chroot? + volatile-root? (mounts '())) "This procedure is meant to be called from an initrd. Boot a system by first loading LINUX-MODULES, then setting up QEMU guest networking if @@ -191,7 +193,10 @@ MOUNTS must be a list of elements of the form: (FILE-SYSTEM-TYPE SOURCE TARGET) When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in -the new root." +the new root. + +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost." (define (resolve file) ;; If FILE is a symlink to an absolute file name, resolve it as if we were ;; under /root. @@ -201,6 +206,8 @@ the new root." (resolve (string-append "/root" target))) file))) + (define MS_RDONLY 1) + (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") @@ -236,12 +243,36 @@ the new root." (if root (catch #t (lambda () - (mount root "/root" "ext3")) + (if volatile-root? + (begin + ;; XXX: For lack of a union file system... + (mkdir-p "/real-root") + (mount root "/real-root" "ext3" MS_RDONLY) + (mount "none" "/root" "tmpfs") + + ;; XXX: 'copy-recursively' cannot deal with device nodes, so + ;; explicitly avoid /dev. + (for-each (lambda (file) + (unless (string=? "dev" file) + (copy-recursively (string-append "/real-root/" + file) + (string-append "/root/" + file) + #:log (%make-void-port + "w")))) + (scandir "/real-root" + (lambda (file) + (not (member file '("." "..")))))) + + ;; TODO: Unmount /real-root. + ) + (mount root "/root" "ext3"))) (lambda args (format (current-error-port) "exception while mounting '~a': ~s~%" root args) (start-repl))) (mount "none" "/root" "tmpfs")) + (mount-essential-file-systems #:root "/root") (unless (file-exists? "/root/dev") |