me/guix
Archived
1
0
Fork 0
Code Activity

installer: Check partitions UUIDs.

Browse source 
* 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.
This commit is contained in:
Mathieu Othacehe 2021-06-11 19:19:59 +02:00
parent 1a0a18d0cc
commit f5d9d6ec68
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 51 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gnu/installer/newt/partition.scm
View file

@ -709,6 +709,13 @@ by pressing the Exit button.~%~%")))
(run-error-page (run-error-page
(G_ "No root mount point found.") (G_ "No root mount point found.")
(G_ "Missing mount point")) (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)) #f))
(check-user-partitions user-partitions)))) (check-user-partitions user-partitions))))
(if user-partitions-ok? (if user-partitions-ok?

42
gnu/installer/parted.scm
View file

@ -107,6 +107,9 @@
&no-root-mount-point &no-root-mount-point
no-root-mount-point? no-root-mount-point?
&cannot-read-uuid
cannot-read-uuid?
cannot-read-uuid-partition
check-user-partitions check-user-partitions
set-user-partitions-file-name set-user-partitions-file-name
@ -1006,16 +1009,49 @@ exists."
(define-condition-type &no-root-mount-point &condition (define-condition-type &no-root-mount-point &condition
no-root-mount-point?) 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) (define (check-user-partitions user-partitions)
"Return #t if the USER-PARTITIONS lists contains one <user-partition> record "Check the following statements:
with a mount-point set to '/', raise &no-root-mount-point condition
otherwise." 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 (let ((mount-points
(map user-partition-mount-point user-partitions))) (map user-partition-mount-point user-partitions)))
(or (member "/" mount-points) (or (member "/" mount-points)
(raise (raise
(condition (&no-root-mount-point)))))) (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) (define (set-user-partitions-file-name user-partitions)
"Set the partition file-name of <user-partition> records in USER-PARTITIONS "Set the partition file-name of <user-partition> records in USER-PARTITIONS
list and return the updated list." list and return the updated list."