diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2021-06-11 19:19:59 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2021-06-12 09:31:33 +0200 |
commit | f5d9d6ec68f78f5651bd5a698f489ab57bf77d5d (patch) | |
tree | 5716f9f3072e00d13387ee38622baa9a93e20dea | |
parent | 1a0a18d0ccc6cb6c7f4e42a0d659340f13b206c5 (diff) | |
download | guix-f5d9d6ec68f78f5651bd5a698f489ab57bf77d5d.tar.gz guix-f5d9d6ec68f78f5651bd5a698f489ab57bf77d5d.zip |
installer: Check partitions UUIDs.
* gnu/installer/parted.scm (&cannot-read-uuid): New condition.
(cannot-read-uuid?, cannot-read-uuid-partition): New procedures.
(check-user-partitions): Check that all user-partitions have a valid UUID,
raide the above condition otherwise.
* gnu/installer/newt/partition.scm (run-disk-page): Run an error page if the
&cannot-read-uuid condition is raised.
-rw-r--r-- | gnu/installer/newt/partition.scm | 7 | ||||
-rw-r--r-- | gnu/installer/parted.scm | 52 |
2 files changed, 51 insertions, 8 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 1f920f5903..1c0444b67f 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -709,6 +709,13 @@ by pressing the Exit button.~%~%"))) (run-error-page (G_ "No root mount point found.") (G_ "Missing mount point")) + #f) + ((cannot-read-uuid? c) + (run-error-page + (format #f (G_ "Cannot read the ~a partition UUID.\ + You may need to format it.") + (cannot-read-uuid-partition c)) + (G_ "Wrong partition format")) #f)) (check-user-partitions user-partitions)))) (if user-partitions-ok? diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 6d6e500d71..930f45ae1c 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -107,6 +107,9 @@ &no-root-mount-point no-root-mount-point? + &cannot-read-uuid + cannot-read-uuid? + cannot-read-uuid-partition check-user-partitions set-user-partitions-file-name @@ -1006,15 +1009,48 @@ exists." (define-condition-type &no-root-mount-point &condition no-root-mount-point?) +;; Cannot not read the partition UUID. +(define-condition-type &cannot-read-uuid &condition + cannot-read-uuid? + (partition cannot-read-uuid-partition)) + (define (check-user-partitions user-partitions) - "Return #t if the USER-PARTITIONS lists contains one <user-partition> record -with a mount-point set to '/', raise &no-root-mount-point condition -otherwise." - (let ((mount-points - (map user-partition-mount-point user-partitions))) - (or (member "/" mount-points) - (raise - (condition (&no-root-mount-point)))))) + "Check the following statements: + +The USER-PARTITIONS list contains one <user-partition> record with a +mount-point set to '/'. Raise &no-root-mount-point condition otherwise. + +All the USER-PARTITIONS with a mount point and that will not be formatted have +a valid UUID. Raise a &cannot-read-uuid condition specifying the faulty +partition otherwise. + +Return #t if all the statements are valid." + (define (check-root) + (let ((mount-points + (map user-partition-mount-point user-partitions))) + (or (member "/" mount-points) + (raise + (condition (&no-root-mount-point)))))) + + (define (check-uuid) + (let ((mount-partitions + (filter user-partition-mount-point user-partitions))) + (every + (lambda (user-partition) + (let ((file-name (user-partition-file-name user-partition)) + (need-formatting? + (user-partition-need-formatting? user-partition))) + (or need-formatting? + (read-partition-uuid file-name) + (raise + (condition + (&cannot-read-uuid + (partition file-name))))))) + mount-partitions))) + + (and (check-root) + (check-uuid) + #t)) (define (set-user-partitions-file-name user-partitions) "Set the partition file-name of <user-partition> records in USER-PARTITIONS |