[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: installer: Check partitions UUIDs.
From: |
guix-commits |
Subject: |
02/02: installer: Check partitions UUIDs. |
Date: |
Sat, 12 Jun 2021 03:31:49 -0400 (EDT) |
mothacehe pushed a commit to branch master
in repository guix.
commit f5d9d6ec68f78f5651bd5a698f489ab57bf77d5d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Jun 11 19:19:59 2021 +0200
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.
---
gnu/installer/newt/partition.scm | 7 ++++++
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 1f920f5..1c0444b 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 6d6e500..930f45a 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