summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-14 23:59:08 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-14 23:59:08 +0200
commit1c96c1bbabb9646aba2a3860cac02157f56c4dd1 (patch)
tree7dfcfaaa6580404a1fe774b6c4c28edc9c984ec8
parent0b7a0c2030fe85fc54f428e1d874017d4072eead (diff)
linux-initrd: Mount / as a unionfs when asking for a volatile root.
* guix/build/linux-initrd.scm (make-essential-device-nodes): Make /dev/fuse. (boot-system): Add #:unionfs parameter. Invoke UNIONFS instead of copying files over when VOLATILE-ROOT? is true. * gnu/system/linux-initrd.scm (expression->initrd): Add #:inputs parameter. [files-to-copy]: New procedure. [builder]: Add 'to-copy' parameter; honor it. (qemu-initrd)[linux-modules]: Add 'fuse.ko' when VOLATILE-ROOT?. Pass UNIONFS-FUSE/STATIC as #:inputs; change builder to pass #:unionfs to 'boot-system'.
-rw-r--r--gnu/system/linux-initrd.scm75
-rw-r--r--guix/build/linux-initrd.scm38
2 files changed, 73 insertions, 40 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 42ca29cb58..786e068764 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -21,12 +21,15 @@
#:use-module (guix utils)
#:use-module ((guix store)
#:select (%store-prefix))
+ #:use-module ((guix derivations)
+ #:select (derivation->output-path))
#: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 (ice-9 match)
#:use-module (ice-9 regex)
#:export (expression->initrd
qemu-initrd
@@ -49,12 +52,14 @@
(name "guile-initrd")
(system (%current-system))
(modules '())
+ (inputs '())
(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. MODULES is a
-list of Guile module names to be embedded in the initrd."
+of `.ko' file names to be copied from LINUX into the initrd. INPUTS is a list
+of additional inputs to be copied in 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'.
@@ -63,7 +68,16 @@ list of Guile module names to be embedded in the initrd."
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
- (define builder
+ (define (files-to-copy)
+ (mlet %store-monad ((inputs (lower-inputs inputs)))
+ (return (map (match-lambda
+ ((_ drv)
+ (derivation->output-path drv))
+ ((_ drv sub-drv)
+ (derivation->output-path drv sub-drv)))
+ inputs))))
+
+ (define (builder to-copy)
`(begin
(use-modules (guix build utils)
(ice-9 pretty-print)
@@ -137,6 +151,18 @@ list of Guile module names to be embedded in the initrd."
,module module-dir))))
linux-modules))
+ ,@(if (null? to-copy)
+ '()
+ `((let ((store ,(string-append "." (%store-prefix))))
+ (mkdir-p store)
+ ;; XXX: Should we do export-references-graph?
+ (for-each (lambda (input)
+ (let ((target
+ (string-append store "/"
+ (basename input))))
+ (copy-recursively input target)))
+ ',to-copy))))
+
;; Reset the timestamps of all the files that will make it in the
;; initrd.
(for-each (cut utime <> 0 0 0 0)
@@ -184,8 +210,10 @@ list of Guile module names to be embedded in the initrd."
("modules/compiled" ,compiled)
,@(if linux
`(("linux" ,linux))
- '())))))
- (derivation-expression name builder
+ '())
+ ,@inputs)))
+ (to-copy (files-to-copy)))
+ (derivation-expression name (builder to-copy)
#:modules '((guix build utils))
#:inputs inputs)))
@@ -224,22 +252,31 @@ to it are lost."
'())
,@(if (assoc-ref mounts '9p)
virtio-9p-modules
+ '())
+ ,@(if volatile-root?
+ '("fuse.ko")
'())))
- (expression->initrd
- `(begin
- (use-modules (guix build linux-initrd))
-
- (boot-system #:mounts ',mounts
- #:linux-modules ',linux-modules
- #:qemu-guest-networking? #t
- #:guile-modules-in-chroot? ',guile-modules-in-chroot?
- #:volatile-root? ',volatile-root?))
- #:name "qemu-initrd"
- #:modules '((guix build utils)
- (guix build linux-initrd))
- #:linux linux-libre
- #:linux-modules linux-modules))
+ (mlet %store-monad
+ ((unionfs (package-file unionfs-fuse/static "bin/unionfs")))
+ (expression->initrd
+ `(begin
+ (use-modules (guix build linux-initrd))
+
+ (boot-system #:mounts ',mounts
+ #:linux-modules ',linux-modules
+ #:qemu-guest-networking? #t
+ #:guile-modules-in-chroot? ',guile-modules-in-chroot?
+ #:unionfs ,unionfs
+ #:volatile-root? ',volatile-root?))
+ #:name "qemu-initrd"
+ #:modules '((guix build utils)
+ (guix build linux-initrd))
+ #:linux linux-libre
+ #:linux-modules linux-modules
+ #:inputs (if volatile-root?
+ `(("unionfs" ,unionfs-fuse/static))
+ '()))))
(define (gnu-system-initrd)
"Initrd for the GNU system itself, with nothing QEMU-specific."
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 61d4304b65..5d4446e720 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -143,7 +143,10 @@
(symlink "/proc/self/fd" (scope "dev/fd"))
(symlink "/proc/self/fd/0" (scope "dev/stdin"))
(symlink "/proc/self/fd/1" (scope "dev/stdout"))
- (symlink "/proc/self/fd/2" (scope "dev/stderr")))
+ (symlink "/proc/self/fd/2" (scope "dev/stderr"))
+
+ ;; File systems in user space (FUSE).
+ (mknod (scope "dev/fuse") 'char-special #o666 (device-number 10 229)))
(define %host-qemu-ipv4-address
(inet-pton AF_INET "10.0.2.10"))
@@ -212,7 +215,7 @@ the last argument of `mknod'."
(linux-modules '())
qemu-guest-networking?
guile-modules-in-chroot?
- volatile-root?
+ volatile-root? unionfs
(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
@@ -277,27 +280,20 @@ to it are lost."
(lambda ()
(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.
- )
+ (mkdir-p "/rw-root")
+ (mount "none" "/rw-root" "tmpfs")
+
+ ;; We want read-write /dev nodes.
+ (make-essential-device-nodes #:root "/rw-root")
+
+ ;; Make /root a union of the tmpfs and the actual root.
+ (unless (zero? (system* unionfs "-o"
+ "cow,allow_other,use_ino,dev"
+ "/rw-root=RW:/real-root=RO"
+ "/root"))
+ (error "unionfs failed")))
(mount root "/root" "ext3")))
(lambda args
(format (current-error-port) "exception while mounting '~a': ~s~%"