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'.
master
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

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

@ -21,12 +21,15 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix store) #:use-module ((guix store)
#:select (%store-prefix)) #:select (%store-prefix))
#:use-module ((guix derivations)
#:select (derivation->output-path))
#:use-module (gnu packages cpio) #:use-module (gnu packages cpio)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap) #:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
#:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export (expression->initrd #:export (expression->initrd
qemu-initrd qemu-initrd
@ -49,12 +52,14 @@
(name "guile-initrd") (name "guile-initrd")
(system (%current-system)) (system (%current-system))
(modules '()) (modules '())
(inputs '())
(linux #f) (linux #f)
(linux-modules '())) (linux-modules '()))
"Return a package that contains a Linux initrd (a gzipped cpio archive) "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 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 of `.ko' file names to be copied from LINUX into the initrd. INPUTS is a list
list of Guile module names to be embedded in the initrd." 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 ;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. ;; `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. ;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$")) (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 `(begin
(use-modules (guix build utils) (use-modules (guix build utils)
(ice-9 pretty-print) (ice-9 pretty-print)
@ -137,6 +151,18 @@ list of Guile module names to be embedded in the initrd."
,module module-dir)))) ,module module-dir))))
linux-modules)) 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 ;; Reset the timestamps of all the files that will make it in the
;; initrd. ;; initrd.
(for-each (cut utime <> 0 0 0 0) (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) ("modules/compiled" ,compiled)
,@(if linux ,@(if linux
`(("linux" ,linux)) `(("linux" ,linux))
'()))))) '())
(derivation-expression name builder ,@inputs)))
(to-copy (files-to-copy)))
(derivation-expression name (builder to-copy)
#:modules '((guix build utils)) #:modules '((guix build utils))
#:inputs inputs))) #:inputs inputs)))
@ -224,22 +252,31 @@ to it are lost."
'()) '())
,@(if (assoc-ref mounts '9p) ,@(if (assoc-ref mounts '9p)
virtio-9p-modules virtio-9p-modules
'())
,@(if volatile-root?
'("fuse.ko")
'()))) '())))
(expression->initrd (mlet %store-monad
`(begin ((unionfs (package-file unionfs-fuse/static "bin/unionfs")))
(use-modules (guix build linux-initrd)) (expression->initrd
`(begin
(use-modules (guix build linux-initrd))
(boot-system #:mounts ',mounts (boot-system #:mounts ',mounts
#:linux-modules ',linux-modules #:linux-modules ',linux-modules
#:qemu-guest-networking? #t #:qemu-guest-networking? #t
#:guile-modules-in-chroot? ',guile-modules-in-chroot? #:guile-modules-in-chroot? ',guile-modules-in-chroot?
#:volatile-root? ',volatile-root?)) #:unionfs ,unionfs
#:name "qemu-initrd" #:volatile-root? ',volatile-root?))
#:modules '((guix build utils) #:name "qemu-initrd"
(guix build linux-initrd)) #:modules '((guix build utils)
#:linux linux-libre (guix build linux-initrd))
#:linux-modules linux-modules)) #:linux linux-libre
#:linux-modules linux-modules
#:inputs (if volatile-root?
`(("unionfs" ,unionfs-fuse/static))
'()))))
(define (gnu-system-initrd) (define (gnu-system-initrd)
"Initrd for the GNU system itself, with nothing QEMU-specific." "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" (scope "dev/fd"))
(symlink "/proc/self/fd/0" (scope "dev/stdin")) (symlink "/proc/self/fd/0" (scope "dev/stdin"))
(symlink "/proc/self/fd/1" (scope "dev/stdout")) (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 (define %host-qemu-ipv4-address
(inet-pton AF_INET "10.0.2.10")) (inet-pton AF_INET "10.0.2.10"))
@ -212,7 +215,7 @@ the last argument of `mknod'."
(linux-modules '()) (linux-modules '())
qemu-guest-networking? qemu-guest-networking?
guile-modules-in-chroot? guile-modules-in-chroot?
volatile-root? volatile-root? unionfs
(mounts '())) (mounts '()))
"This procedure is meant to be called from an initrd. Boot a system by "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 first loading LINUX-MODULES, then setting up QEMU guest networking if
@ -277,27 +280,20 @@ to it are lost."
(lambda () (lambda ()
(if volatile-root? (if volatile-root?
(begin (begin
;; XXX: For lack of a union file system...
(mkdir-p "/real-root") (mkdir-p "/real-root")
(mount root "/real-root" "ext3" MS_RDONLY) (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 ;; We want read-write /dev nodes.
;; explicitly avoid /dev. (make-essential-device-nodes #:root "/rw-root")
(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. ;; 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"))) (mount root "/root" "ext3")))
(lambda args (lambda args
(format (current-error-port) "exception while mounting '~a': ~s~%" (format (current-error-port) "exception while mounting '~a': ~s~%"