[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
14/21: installer: Issue message to user on failure of filesystems task.
From: |
John Darrington |
Subject: |
14/21: installer: Issue message to user on failure of filesystems task. |
Date: |
Sat, 31 Dec 2016 14:54:18 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit 827b389e169e080e089273738871c13781a2c7e4
Author: John Darrington <address@hidden>
Date: Fri Dec 30 14:17:09 2016 +0100
installer: Issue message to user on failure of filesystems task.
* gnu/system/installer/filesystems.scm (filesystem-task-incomplete-reason):
New procedure,
(filesystem-task-complete?): redefine in terms of aforementioned procedure,
(filesystem-page-key-handler): Inform the user about the reason for failure.
---
gnu/system/installer/filesystems.scm | 88 ++++++++++++++++++----------------
1 file changed, 47 insertions(+), 41 deletions(-)
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 927248b..0f67342 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -37,14 +37,36 @@
(define minimum-store-size 7000)
(define (filesystem-task-complete?)
- (and (find-mount-device "/" mount-points) ; A device for / must exist
- (>= (size-of-partition (find-mount-device "/gnu" mount-points))
- minimum-store-size) ; /gnu must have enough space
-
- ;; All partitions must have a filesystem
- (fold (lambda (x prev)
- (and (string-prefix? "ext" (partition-fs (string->partition
(car x))))
- prev)) #t mount-points)))
+ (not (filesystem-task-incomplete-reason)))
+
+(define (filesystem-task-incomplete-reason)
+ "Returns #f if the task is complete. Otherwise a string explaining why not."
+ (or
+ (and (< (size-of-partition (find-mount-device "/gnu" mount-points))
+ minimum-store-size)
+ (format #f
+ (N_ "The filesystem for /gnu requires at least ~aGB.")
+ (/ minimum-store-size 1000)))
+
+ (and (not (find-mount-device "/" mount-points))
+ (N_ "You must specify a mount point for the root (/)."))
+
+ (let ((partitions-without-filesystems
+ (fold (lambda (x prev)
+ (if (not (string-prefix? "ext"
+ (partition-fs (string->partition
+ (car x)))))
+ (cons (car x) prev)
+ prev)) '() mount-points)))
+
+ (if (null? partitions-without-filesystems)
+ #f
+ (ngettext
+ (format #f (N_ "The partition ~a does not contain a filesystem.")
+ (car partitions-without-filesystems))
+ (format #f (N_ "The partitions ~a do not contain filesystems.")
+ partitions-without-filesystems)
+ (length partitions-without-filesystems))))))
(define (make-filesystem-page parent title)
(make-page (page-surface parent)
@@ -106,14 +128,14 @@
((menu-active menu)
(menu-set-active! menu #f)
(buttons-select nav 0))
-
+
((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
(menu-set-active! menu #t)
(buttons-unselect-all nav))
-
+
(else
(buttons-select-next nav))))
-
+
((eq? ch KEY_LEFT)
(menu-set-active! menu #f)
(buttons-select-prev nav))
@@ -141,35 +163,19 @@
(delwin (inner (page-wwin page)))
(set! page-stack (cdr page-stack)))
-
+
((buttons-key-matches-symbol? nav ch 'continue)
- (cond
- ((not (find-mount-device "/" mount-points))
- (let ((next
- (make-dialog
- page
- (gettext
- "You must choose a device on which to mount the root (/) of
the operating system's filesystem."))))
- (set! page-stack (cons next page-stack))
- ((page-refresh next) next)))
-
- ((< (size-of-partition (find-mount-device "/gnu" mount-points))
minimum-store-size)
- (let ((next
- (make-dialog
- page
- (format #f
- (gettext
- "The filesystem for ~a needs at least ~aGB of disk
space.")
- "/gnu"
- (/ minimum-store-size 1000)))))
- (set! page-stack (cons next page-stack))
- ((page-refresh next) next)))
-
- (else
- (delwin (outer (page-wwin page)))
- (set! page-stack (cdr page-stack))
- ((page-refresh (car page-stack)) (car page-stack))
- ))))
+ (let ((errstr (filesystem-task-incomplete-reason)))
+ (if errstr
+ (let ((next (make-dialog page errstr)))
+ (set! page-stack (cons next page-stack))
+ ((page-refresh next) next))
+ (begin
+ (delwin (outer (page-wwin page)))
+ (set! page-stack (cdr page-stack))
+ ((page-refresh (car page-stack)) (car page-stack)))
+ ))))
+
(std-menu-key-handler menu ch))
#f
)
@@ -183,7 +189,7 @@
(text-window (derwin (inner pr) 3 (getmaxx (inner pr))
0 0))
-
+
(bwin (derwin (inner pr)
3 (getmaxx (inner pr))
(- (getmaxy (inner pr)) 3) 0
@@ -194,7 +200,7 @@
(- (getmaxy (inner pr)) 3 (getmaxy text-window))
(- (getmaxx (inner pr)) 0)
(getmaxy text-window) 0 #:panel #f))
-
+
(menu (make-menu (partition-volume-pairs)
#:disp-proc
(lambda (d row)
- 03/21: installer: Add inetutils bin directory to PATH., (continued)
- 03/21: installer: Add inetutils bin directory to PATH., John Darrington, 2016/12/31
- 05/21: installer: Enable scrolling in the installation window., John Darrington, 2016/12/31
- 06/21: installer: Wrap installer in (catch #t ...), John Darrington, 2016/12/31
- 16/21: installer: Prevent the user specifying the same mount point twice., John Darrington, 2016/12/31
- 04/21: installer: Turn off kernel ring messages to console., John Darrington, 2016/12/31
- 01/21: installer: Add wireless-tools bin directory to PATH., John Darrington, 2016/12/31
- 02/21: installer: Replace an instance of cdr with match., John Darrington, 2016/12/31
- 12/21: installer: Close unused ports in pipe-cmd., John Darrington, 2016/12/31
- 08/21: installer: Use consistent window heights., John Darrington, 2016/12/31
- 20/21: installer: Do not use /tmp for holding the configuration., John Darrington, 2016/12/31
- 14/21: installer: Issue message to user on failure of filesystems task.,
John Darrington <=
- 07/21: installer: Rename module "new" to "guixsd-installer"., John Darrington, 2016/12/31
- 13/21: installer: Replace spawned mount command with the mount syscall., John Darrington, 2016/12/31
- 11/21: installer: Improve install page., John Darrington, 2016/12/31
- 10/21: installer: Replace "%temporary-configuration-file-port" with "config-file"., John Darrington, 2016/12/31
- 19/21: installer: Use global variable instead of string literal for "/gnu"., John Darrington, 2016/12/31
- 17/21: installer: Change N_ from a procedure to a macro., John Darrington, 2016/12/31
- 18/21: installer: Change the order of the filesystem task conditions., John Darrington, 2016/12/31
- 15/21: installer: Allow users to remove mount points during configuration., John Darrington, 2016/12/31
- 21/21: installer: Add a console-keymap service., John Darrington, 2016/12/31
- 09/21: installer: Fix bug where window-pipe did not return the proper exit status., John Darrington, 2016/12/31