guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

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'.
version-0.8.3
Ludovic Courtès 8 years ago
parent
0b7a0c2030
commit
1c96c1bbab
2 changed files with 73 additions and 40 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 75
      gnu/system/linux-initrd.scm
  2. 38
      guix/build/linux-initrd.scm

75
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,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."

38
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")
;; 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~%"

Write Preview
Loading…
Cancel
Save