diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 20 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 19 | ||||
| -rw-r--r-- | gnu/system/uuid.scm | 9 |
3 files changed, 40 insertions, 8 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index b9eda80958..e69cfd06e6 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2020 Google LLC ;;; Copyright © 2020 Jakub Kądziołka <[email protected]> ;;; Copyright © 2020, 2021 Maxim Cournoyer <[email protected]> +;;; Copyright © 2021 Tobias Geerinckx-Rice <[email protected]> ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,6 +52,8 @@ file-system-mount? file-system-mount-may-fail? file-system-check? + file-system-skip-check-if-clean? + file-system-repair file-system-create-mount-point? file-system-dependencies file-system-location @@ -123,6 +126,10 @@ (default #f)) (check? file-system-check? ; Boolean (default #t)) + (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean + (default #t)) + (repair file-system-repair ; symbol or #f + (default 'preen)) (create-mount-point? file-system-create-mount-point? ; Boolean (default #f)) (dependencies file-system-dependencies ; list of <file-system> @@ -318,19 +325,22 @@ store--e.g., if FS is the root file system." initrd code." (match fs (($ <file-system> device mount-point type flags options mount? - mount-may-fail? needed-for-boot? check?) + mount-may-fail? needed-for-boot? + check? skip-check-if-clean? repair) ;; Note: Add new fields towards the end for compatibility. (list (cond ((uuid? device) `(uuid ,(uuid-type device) ,(uuid-bytevector device))) ((file-system-label? device) `(file-system-label ,(file-system-label->string device))) (else device)) - mount-point type flags options mount-may-fail? check?)))) + mount-point type flags options mount-may-fail? + check? skip-check-if-clean? repair)))) (define (spec->file-system sexp) "Deserialize SEXP, a list, to the corresponding <file-system> object." (match sexp - ((device mount-point type flags options mount-may-fail? check? + ((device mount-point type flags options mount-may-fail? + check? skip-check-if-clean? repair _ ...) ;placeholder for new fields (file-system (device (match device @@ -343,7 +353,9 @@ initrd code." (mount-point mount-point) (type type) (flags flags) (options options) (mount-may-fail? mount-may-fail?) - (check? check?))))) + (check? check?) + (skip-check-if-clean? skip-check-if-clean?) + (repair repair))))) (define (specification->file-system-mapping spec writable?) "Read the SPEC and return the corresponding <file-system-mapping>. SPEC is diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8c245b8445..a083292fcf 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -210,6 +210,16 @@ upon error." (open source targets))) mapped-devices)) + (define file-system-scan-commands + ;; File systems like btrfs need help to assemble multi-device file systems + ;; but do not use manually-specified <mapped-devices>. + (let ((file-system-types (map file-system-type file-systems))) + (if (member "btrfs" file-system-types) + ;; Ignore errors: if the system manages to boot anyway, the better. + #~((system* (string-append #$btrfs-progs/static "/bin/btrfs") + "device" "scan")) + #~()))) + (define kodir (flat-linux-module-directory linux linux-modules)) @@ -245,7 +255,8 @@ upon error." (map spec->file-system '#$(map file-system->spec file-systems)) #:pre-mount (lambda () - (and #$@device-mapping-commands)) + (and #$@device-mapping-commands + #$@file-system-scan-commands)) #:linux-modules '#$linux-modules #:linux-module-directory '#$kodir #:keymap-file #+(and=> keyboard-layout @@ -269,7 +280,7 @@ FILE-SYSTEMS." (list fatfsck/static) '()) ,@(if (find (file-system-type-predicate "bcachefs") file-systems) - (list bcachefs-tools/static) + (list bcachefs/static) '()) ,@(if (find (file-system-type-predicate "btrfs") file-systems) (list btrfs-progs/static) @@ -279,6 +290,9 @@ FILE-SYSTEMS." '()) ,@(if (find (file-system-type-predicate "f2fs") file-systems) (list f2fs-fsck/static) + '()) + ,@(if (find (file-system-type-predicate "xfs") file-systems) + (list xfs_repair/static) '()))) (define-syntax vhash ;TODO: factorize @@ -311,6 +325,7 @@ FILE-SYSTEMS." ("iso9660" => '("isofs")) ("jfs" => '("jfs")) ("f2fs" => '("f2fs" "crc32_generic")) + ("xfs" => '("xfs")) (else '()))) (define (file-system-modules file-systems) diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm index f4c4be6e2b..a95dc1b7d1 100644 --- a/gnu/system/uuid.scm +++ b/gnu/system/uuid.scm @@ -47,6 +47,7 @@ string->fat-uuid string->jfs-uuid string->ntfs-uuid + string->xfs-uuid iso9660-uuid->string ;; XXX: For lack of a better place. @@ -239,7 +240,9 @@ ISO9660 UUID representation." (define string->ext4-uuid string->dce-uuid) (define string->bcachefs-uuid string->dce-uuid) (define string->btrfs-uuid string->dce-uuid) +(define string->f2fs-uuid string->dce-uuid) (define string->jfs-uuid string->dce-uuid) +(define string->xfs-uuid string->dce-uuid) (define-syntax vhashq (syntax-rules (=>) @@ -253,14 +256,16 @@ ISO9660 UUID representation." (define %uuid-parsers (vhashq - ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => string->dce-uuid) + ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks + => string->dce-uuid) ('fat32 'fat16 'fat => string->fat-uuid) ('ntfs => string->ntfs-uuid) ('iso9660 => string->iso9660-uuid))) (define %uuid-printers (vhashq - ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => dce-uuid->string) + ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks + => dce-uuid->string) ('iso9660 => iso9660-uuid->string) ('fat32 'fat16 'fat => fat-uuid->string) ('ntfs => ntfs-uuid->string))) |