nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2014-04-14 23:59:08 +02:00
parent 0b7a0c2030
commit 1c96c1bbab
2 changed files with 70 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
gnu/system/linux-initrd.scm
View File

@ -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,8 +252,13 @@ to it are lost."
'())
,@(if (assoc-ref mounts '9p)
virtio-9p-modules
'())
,@(if volatile-root?
'("fuse.ko")
'())))
(mlet %store-monad
((unionfs (package-file unionfs-fuse/static "bin/unionfs")))
(expression->initrd
`(begin
(use-modules (guix build linux-initrd))
@ -234,12 +267,16 @@ to it are lost."
#: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))
#: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."

34
guix/build/linux-initrd.scm
View File

@ -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~%"