From 3c05b4bc2528ea64b259477bf58dbcc6a7739f78 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 4 May 2014 00:30:39 +0200 Subject: linux-initrd: Check the root and other early file systems. * gnu/system.scm (operating-system-derivation)[boot-file-systems]: Keep "/". * gnu/system/linux-initrd.scm (file-system->spec): Keep the 'check?' flag. (qemu-initrd)[helper-packages]: New variable. Pass it as #:to-copy. : Add 'set-path-environment-variable' call. Remove #:unionfs argument for 'boot-system'. * gnu/system/vm.scm (%linux-vm-file-systems): Add 'check?' field/ (virtualized-operating-system): Likewise for the "9p" file system. * guix/build/linux-initrd.scm (mount-root-file-system): Change #:unionfs default. Call 'check-file-system' before mounting ROOT, when VOLATILE-ROOT? is false. (check-file-system): New procedure. (mount-file-system): Honor 'check?' element in list; add 'check-file-system' call. (boot-system): Remove #:root-fs-type and #:unionfs parameters. [root-mount-point?, root-fs-type]: New variables. Call 'mount-file-system' on all MOUNTS but "/". --- guix/build/linux-initrd.scm | 62 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 50 insertions(+), 12 deletions(-) (limited to 'guix/build/linux-initrd.scm') diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index fd6c0c4673..b2cbcae7d8 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -190,7 +190,7 @@ the last argument of `mknod'." (+ (* major 256) minor)) (define* (mount-root-file-system root type - #:key volatile-root? unionfs) + #:key volatile-root? (unionfs "unionfs")) "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is true, mount ROOT read-only and make it a union with a writable tmpfs using UNIONFS." @@ -212,20 +212,45 @@ UNIONFS." "/rw-root=RW:/real-root=RO" "/root")) (error "unionfs failed"))) - (mount root "/root" type))) + (begin + (check-file-system root type) + (mount root "/root" type)))) (lambda args (format (current-error-port) "exception while mounting '~a': ~s~%" root args) (start-repl)))) +(define (check-file-system device type) + "Run a file system check of TYPE on DEVICE." + (define fsck + (string-append "fsck." type)) + + (let ((status (system* fsck "-v" "-p" device))) + (match (status:exit-val status) + (0 + #t) + (1 + (format (current-error-port) "'~a' corrected errors on ~a; continuing~%" + fsck device)) + (2 + (format (current-error-port) "'~a' corrected errors on ~a; rebooting~%" + fsck device) + (sleep 3) + (reboot)) + (code + (format (current-error-port) "'~a' exited with code ~a on ~a; spawning REPL~%" + fsck code device) + (start-repl))))) + (define* (mount-file-system spec #:key (root "/root")) "Mount the file system described by SPEC under ROOT. SPEC must have the form: - (DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS) + (DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?) DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f; -FLAGS must be a list of symbols." +FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to +run a file system check." (define flags->bit-mask (match-lambda (('read-only rest ...) @@ -236,8 +261,10 @@ FLAGS must be a list of symbols." 0))) (match spec - ((source mount-point type (flags ...) options) + ((source mount-point type (flags ...) options check?) (let ((mount-point (string-append root "/" mount-point))) + (when check? + (check-file-system source type)) (mkdir-p mount-point) (mount source mount-point type (flags->bit-mask flags) (if options @@ -248,8 +275,7 @@ FLAGS must be a list of symbols." (linux-modules '()) qemu-guest-networking? guile-modules-in-chroot? - volatile-root? unionfs - (root-fs-type "ext4") + 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 @@ -257,8 +283,8 @@ QEMU-GUEST-NETWORKING? is true, mounting the file systems specified in MOUNTS, and finally booting into the new root if any. The initrd supports kernel command-line options '--load', '--root', and '--repl'. -Mount the root file system, of type ROOT-FS-TYPE, specified by the '--root' -command-line argument, if any. +Mount the root file system, specified by the '--root' command-line argument, +if any. MOUNTS must be a list suitable for 'mount-file-system'. @@ -276,6 +302,18 @@ to it are lost." (resolve (string-append "/root" target))) file))) + (define root-mount-point? + (match-lambda + ((device "/" _ ...) #t) + (_ #f))) + + (define root-fs-type + (or (any (match-lambda + ((device "/" type _ ...) type) + (_ #f)) + mounts) + "ext4")) + (display "Welcome, this is GNU's early boot Guile.\n") (display "Use '--repl' for an initrd REPL.\n\n") @@ -310,8 +348,7 @@ to it are lost." (mkdir "/root")) (if root (mount-root-file-system root root-fs-type - #:volatile-root? volatile-root? - #:unionfs unionfs) + #:volatile-root? volatile-root?) (mount "none" "/root" "tmpfs")) (mount-essential-file-systems #:root "/root") @@ -321,7 +358,8 @@ to it are lost." (make-essential-device-nodes #:root "/root")) ;; Mount the specified file systems. - (for-each mount-file-system mounts) + (for-each mount-file-system + (remove root-mount-point? mounts)) (when guile-modules-in-chroot? ;; Copy the directories that contain .scm and .go files so that the -- cgit v1.2.3