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'.master
Ludovic Courtès
parent
0b7a0c2030
commit
1c96c1bbab
|
|
@ -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))
|
||||
(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?
|
||||
#:volatile-root? ',volatile-root?))
|
||||
#:name "qemu-initrd"
|
||||
#:modules '((guix build utils)
|
||||
(guix build linux-initrd))
|
||||
#:linux linux-libre
|
||||
#:linux-modules linux-modules))
|
||||
(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."
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
(mkdir-p "/rw-root")
|
||||
(mount "none" "/rw-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 '("." ".."))))))
|
||||
;; We want read-write /dev nodes.
|
||||
(make-essential-device-nodes #:root "/rw-root")
|
||||
|
||||
;; TODO: Unmount /real-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~%"
|
||||
|
|
|
|||
Loading…
Reference in New Issue