[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/12: installer: Add a predicate to ensure the partitions have been for
From: |
John Darrington |
Subject: |
05/12: installer: Add a predicate to ensure the partitions have been formatted. |
Date: |
Sun, 15 Jan 2017 15:45:39 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit d35d9f1b3d79aef67e277401d094701e3a260a19
Author: John Darrington <address@hidden>
Date: Sat Jan 14 21:46:29 2017 +0100
installer: Add a predicate to ensure the partitions have been formatted.
* gnu/system/installer/format.scm (device-fs-uuid,
filesystems-are-current?):
New procedures.
* gnu/system/installer/guixsd-installer.scm (main-options): Update
prerequisites
for install. Update predicate for format.
---
gnu/system/installer/format.scm | 24 +++++++++++++++++++++++-
gnu/system/installer/guixsd-installer.scm | 4 ++--
2 files changed, 25 insertions(+), 3 deletions(-)
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 2f965cc..73ab172 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -25,10 +25,32 @@
#:use-module (ice-9 match)
#:use-module (gurses buttons)
#:use-module (ncurses curses)
-
+ #:use-module (srfi srfi-1)
+
+ #:export (filesystems-are-current?)
#:export (make-format-page))
+(define (device-fs-uuid dev)
+ "Retrieve the UUID of the filesystem on DEV, where DEV is the name of the
+device such as /dev/sda1"
+ (car (assoc-ref
+ (slurp (string-append "blkid -o export " dev)
+ (lambda (x)
+ (string-split x #\=))) "UUID")))
+
+(define (filesystems-are-current?)
+ "Returns #t iff there is at least one mount point AND all mount-points' uuids
+match those uuids read from the respective partitions"
+ (and (not (null? mount-points))
+ (fold (lambda (mp prev)
+ (and prev
+ (match mp
+ ((dev . (? file-system-spec? fss))
+ (equal? (device-fs-uuid dev)
+ (file-system-spec-uuid fss))))))
+ #t mount-points)))
+
(define (make-format-page parent title)
(let ((page (make-page (page-surface parent)
title
diff --git a/gnu/system/installer/guixsd-installer.scm
b/gnu/system/installer/guixsd-installer.scm
index 1be2bea..8e8c70f 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -89,7 +89,7 @@
(format . ,(make-task format-menu-title
'(filesystems)
- (lambda () #f)
+ filesystems-are-current?
(lambda (page)
(make-format-page
page
@@ -144,7 +144,7 @@
generate-menu-title))))
(install . ,(make-task installation-menu-title
- '(network generate)
+ '(network generate format)
(lambda () #f)
(lambda (page)
(make-install-page
- branch wip-installer updated (3673cd8 -> ac6599d), John Darrington, 2017/01/15
- 08/12: installer: Correct bug detecting a wireless interface., John Darrington, 2017/01/15
- 01/12: installer: Add callback parameter for forms., John Darrington, 2017/01/15
- 04/12: installer: Add the notion of uuids to prospective filesystems., John Darrington, 2017/01/15
- 05/12: installer: Add a predicate to ensure the partitions have been formatted.,
John Darrington <=
- 09/12: installer: Exit the format page after all partitions are successfully formatted., John Darrington, 2017/01/15
- 11/12: installer: Replace one usage of car with match., John Darrington, 2017/01/15
- 10/12: installer: Do not perform tasks more than once., John Darrington, 2017/01/15
- 12/12: installer: Correct bug where the timezone page returned to the wrong page., John Darrington, 2017/01/15
- 02/12: installer: Remove mkfs capability from mount points page., John Darrington, 2017/01/15
- 06/12: installer: Changed N_ to M_ since N_ is used for another purpose in guix/ui.scm, John Darrington, 2017/01/15
- 07/12: installer: Whitespace changes only, John Darrington, 2017/01/15
- 03/12: installer: Add a dedicated make to format filesystems., John Darrington, 2017/01/15