TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

gnu: linux-initrd: Allow the root file system to be volatile.

Browse source 
* gnu/system/linux-initrd.scm (qemu-initrd): Add 'volatile-root?'
  parameter.
* guix/build/linux-initrd.scm (boot-system): Likewise.  Honor it.
This commit is contained in:
Ludovic Courtès 2014-01-31 14:26:30 +01:00
parent 70b33d81cf
commit 44ddf33ed5
2 changed files with 40 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gnu/system/linux-initrd.scm
View file

@ -191,6 +191,7 @@ (define print0
(define* (qemu-initrd #:key
guile-modules-in-chroot?
volatile-root?
(mounts `((cifs "/store" ,(%store-prefix))
(cifs "/xchg" "/xchg"))))
"Return a monadic derivation that builds an initrd for use in a QEMU guest
@ -202,7 +203,10 @@ (define* (qemu-initrd #:key
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
the new root. This is necessary is the file specified as '--load' needs
access to these modules (which is the case if it wants to even just print an
exception and backtrace!)."
exception and backtrace!).
When VOLATILE-ROOT? is true, the root file system is writable but any changes
to it are lost."
(define cifs-modules
;; Modules needed to mount CIFS file systems.
'("md4.ko" "ecb.ko" "cifs.ko"))
@ -229,7 +233,8 @@ (define linux-modules
(boot-system #:mounts ',mounts
#:linux-modules ',linux-modules
#:qemu-guest-networking? #t
#:guile-modules-in-chroot? ',guile-modules-in-chroot?))
#:guile-modules-in-chroot? ',guile-modules-in-chroot?
#:volatile-root? ',volatile-root?))
#:name "qemu-initrd"
#:modules '((guix build utils)
(guix build linux-initrd))

35
guix/build/linux-initrd.scm
View file

@ -24,6 +24,7 @@ (define-module (guix build linux-initrd)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:use-module (guix build utils)
#:export (mount-essential-file-systems
linux-command-line
@ -179,6 +180,7 @@ (define* (boot-system #:key
(linux-modules '())
qemu-guest-networking?
guile-modules-in-chroot?
volatile-root?
(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
@ -191,7 +193,10 @@ (define* (boot-system #:key
(FILE-SYSTEM-TYPE SOURCE TARGET)
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
the new root."
the new root.
When VOLATILE-ROOT? is true, the root file system is writable but any changes
to it are lost."
(define (resolve file)
;; If FILE is a symlink to an absolute file name, resolve it as if we were
;; under /root.
@ -201,6 +206,8 @@ (define (resolve file)
(resolve (string-append "/root" target)))
file)))
(define MS_RDONLY 1)
(display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n")
@ -236,12 +243,36 @@ (define (resolve file)
(if root
(catch #t
(lambda ()
(mount root "/root" "ext3"))
(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.
)
(mount root "/root" "ext3")))
(lambda args
(format (current-error-port) "exception while mounting '~a': ~s~%"
root args)
(start-repl)))
(mount "none" "/root" "tmpfs"))
(mount-essential-file-systems #:root "/root")
(unless (file-exists? "/root/dev")