linux-initrd: Improve root file system switching.

* guix/build/linux-initrd.scm (move-essential-file-systems,
  switch-root): New procedures.
  (MS_MOVE): New variable.
  (boot-system): Remove 'mount-essential-file-systems' call for ROOT.
  Use 'switch-root' instead of chdir + chroot.
This commit is contained in:
Ludovic Courtès 2014-05-04 22:24:47 +02:00
parent 2d49f84522
commit 1d4628329d

View file

@ -62,6 +62,15 @@ (define (scope dir)
(mkdir (scope "sys"))) (mkdir (scope "sys")))
(mount "none" (scope "sys") "sysfs")) (mount "none" (scope "sys") "sysfs"))
(define (move-essential-file-systems root)
"Move currently mounted essential file systems to ROOT."
(for-each (lambda (dir)
(let ((target (string-append root dir)))
(unless (file-exists? target)
(mkdir target))
(mount dir target "" MS_MOVE)))
'("/proc" "/sys")))
(define (linux-command-line) (define (linux-command-line)
"Return the Linux kernel command line as a list of strings." "Return the Linux kernel command line as a list of strings."
(string-tokenize (string-tokenize
@ -172,6 +181,7 @@ (define* (configure-qemu-networking #:optional (interface "eth0"))
;; Linux mount flags, from libc's <sys/mount.h>. ;; Linux mount flags, from libc's <sys/mount.h>.
(define MS_RDONLY 1) (define MS_RDONLY 1)
(define MS_BIND 4096) (define MS_BIND 4096)
(define MS_MOVE 8192)
(define (bind-mount source target) (define (bind-mount source target)
"Bind-mount SOURCE at TARGET." "Bind-mount SOURCE at TARGET."
@ -271,6 +281,15 @@ (define flags->bit-mask
(string->pointer options) (string->pointer options)
%null-pointer)))))) %null-pointer))))))
(define (switch-root root)
"Switch to ROOT as the root file system, in a way similar to what
util-linux' switch_root(8) does."
(move-essential-file-systems root)
(chdir root)
;; TODO: Delete files from the old root.
(mount root "/" "" MS_MOVE)
(chroot "."))
(define* (boot-system #:key (define* (boot-system #:key
(linux-modules '()) (linux-modules '())
qemu-guest-networking? qemu-guest-networking?
@ -351,8 +370,6 @@ (define root-fs-type
#:volatile-root? volatile-root?) #:volatile-root? volatile-root?)
(mount "none" "/root" "tmpfs")) (mount "none" "/root" "tmpfs"))
(mount-essential-file-systems #:root "/root")
(unless (file-exists? "/root/dev") (unless (file-exists? "/root/dev")
(mkdir "/root/dev") (mkdir "/root/dev")
(make-essential-device-nodes #:root "/root")) (make-essential-device-nodes #:root "/root"))
@ -377,8 +394,7 @@ (define root-fs-type
(if to-load (if to-load
(begin (begin
(format #t "loading '~a'...\n" to-load) (format #t "loading '~a'...\n" to-load)
(chdir "/root") (switch-root "/root")
(chroot "/root")
;; Obviously this has to be done each time we boot. Do it from here ;; Obviously this has to be done each time we boot. Do it from here
;; so that statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3) ;; so that statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3)