summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-06-11 19:19:59 +0200
committerMathieu Othacehe <othacehe@gnu.org>2021-06-12 09:31:33 +0200
commitf5d9d6ec68f78f5651bd5a698f489ab57bf77d5d (patch)
tree5716f9f3072e00d13387ee38622baa9a93e20dea /gnu/installer
parent1a0a18d0ccc6cb6c7f4e42a0d659340f13b206c5 (diff)
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.
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/newt/partition.scm7
-rw-r--r--gnu/installer/parted.scm52
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