summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/newt.scm1
-rw-r--r--gnu/installer/newt/ethernet.scm2
-rw-r--r--gnu/installer/newt/final.scm19
-rw-r--r--gnu/installer/newt/network.scm2
-rw-r--r--gnu/installer/newt/page.scm11
-rw-r--r--gnu/installer/newt/parameters.scm4
-rw-r--r--gnu/installer/newt/partition.scm20
-rw-r--r--gnu/installer/newt/services.scm3
-rw-r--r--gnu/installer/newt/welcome.scm8
-rw-r--r--gnu/installer/newt/wifi.scm3
-rw-r--r--gnu/installer/parted.scm58
-rw-r--r--gnu/installer/steps.scm2
-rw-r--r--gnu/installer/tests.scm31
13 files changed, 111 insertions, 53 deletions
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index fdab721b2f..a1cbeca49a 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -46,6 +46,7 @@
(newt-init)
(clear-screen)
(set-screen-size!)
+ (syslog "Display is ~ax~a.~%" (screen-columns) (screen-rows))
(push-help-line
(format #f (G_ "Press <F1> for installation parameters."))))
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index ba5e222a37..ecd22efbb2 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -77,7 +77,7 @@ connection is pending."
#:title (G_ "Ethernet connection")
#:listbox-items services
#:listbox-item->text ethernet-service->text
- #:listbox-height (min (+ (length services) 2) 10)
+ #:listbox-height (min (+ (length services) 2) 5)
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 89684c4d8a..7f6dd9f075 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -29,6 +29,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
+ #:use-module ((ice-9 rdelim) #:select (read-line))
#:use-module (newt)
#:export (run-final-page))
@@ -39,9 +40,8 @@
file))
(define* (run-config-display-page #:key locale)
- (let ((width (%configuration-file-width))
- (height (nearest-exact-integer
- (/ (screen-rows) 2))))
+ (let ((width (max 70 (- (screen-columns) 20)))
+ (height (default-listbox-height)))
(run-file-textbox-page
#:info-text (format #f (G_ "\
We're now ready to proceed with the installation! \
@@ -107,6 +107,19 @@ a specific step, or restart the installer."))
install-ok?))
(define (run-final-page result prev-steps)
+ (define (wait-for-clients)
+ (unless (null? (current-clients))
+ (syslog "waiting with clients before starting final step~%")
+ (send-to-clients '(starting-final-step))
+ (match (select (current-clients) '() '())
+ (((port _ ...) _ _)
+ (read-line port)))))
+
+ ;; Before generating the configuration file, give clients a chance to do
+ ;; things such as changing the swap partition label.
+ (wait-for-clients)
+
+ (syslog "proceeding with final step~%")
(let* ((configuration (format-configuration prev-steps result))
(user-partitions (result-step result 'partition))
(locale (result-step result 'locale))
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index 461d5d99c0..4af7143d63 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -80,7 +80,7 @@ network devices were found. Do you want to continue anyway?"))
#:title (G_ "Internet access")
#:listbox-items items
#:listbox-item->text technology->text
- #:listbox-height (min (+ (length items) 2) 10)
+ #:listbox-height (min (+ (length items) 2) 5)
#:button-text (G_ "Exit")
#:button-callback-procedure
(lambda _
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 1d6b9979b4..4209674c28 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -32,7 +32,9 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (newt)
- #:export (draw-info-page
+ #:export (default-listbox-height
+
+ draw-info-page
draw-connecting-page
run-input-page
run-error-page
@@ -168,6 +170,10 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"."
(_
(values reason argument))))))
+(define (default-listbox-height)
+ "Return the default listbox height."
+ (max 5 (- (screen-rows) 20)))
+
(define (draw-info-page text title)
"Draw an informative page with the given TEXT as content. Set the title of
this page to TITLE."
@@ -339,7 +345,8 @@ of the page is set to TITLE."
(info-textbox-width 50)
listbox-items
listbox-item->text
- (listbox-height 20)
+ (listbox-height
+ (default-listbox-height))
(listbox-default-item #f)
(listbox-allow-multiple? #f)
(sort-listbox-items? #t)
diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm
index 95112b5780..8fb1aa3abb 100644
--- a/gnu/installer/newt/parameters.scm
+++ b/gnu/installer/newt/parameters.scm
@@ -20,6 +20,7 @@
#:use-module (gnu installer proxy)
#:use-module (gnu installer steps)
#:use-module (gnu installer newt page)
+ #:use-module (guix build syscalls)
#:use-module (guix i18n)
#:use-module (ice-9 match)
#:use-module (newt)
@@ -40,7 +41,8 @@ empty string, proxy usage will be disabled.")
(let* ((items
(list
(cons (G_ "Change keyboard layout") keyboard-layout-selection)
- (cons (G_ "Configure HTTP proxy") run-proxy-page)))
+ (cons (G_ "Configure HTTP proxy") run-proxy-page)
+ (cons (G_ "Reboot") reboot)))
(result
(run-listbox-selection-page
#:info-text (G_ "Please choose one of the following parameters or \
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index ed38287fe8..81cf68d782 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -25,6 +25,7 @@
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,11 +57,17 @@
#:button-callback-procedure button-exit-action)))
(car result)))
-(define (draw-formatting-page)
+(define (draw-formatting-page partitions)
"Draw a page asking for confirmation, and then indicating that partitions
are being formatted."
- (run-confirmation-page (G_ "We are about to format your hard disk. All \
-its data will be lost. Do you wish to continue?")
+ ;; TRANSLATORS: The ~{ and ~} format specifiers are used to iterate the list
+ ;; of device names of the user partitions that will be formatted.
+ (run-confirmation-page (format #f (G_ "We are about to write the configured \
+partition table to the disk and format the partitions listed below. Their \
+data will be lost. Do you wish to continue?~%~%~{ - ~a~%~}")
+ (map user-partition-file-name
+ (filter user-partition-need-formatting?
+ partitions)))
(G_ "Format disk?")
#:exit-button-procedure button-exit-action)
(draw-info-page
@@ -674,7 +681,7 @@ by pressing the Exit button.~%~%")))
(G_ "Guided partitioning")
(G_ "Manual partitioning"))
#:info-textbox-width 76 ;we need a lot of room for INFO-TEXT
- #:listbox-height 12
+ #:listbox-height (max 5 (- (screen-rows) 30))
#:listbox-items (disk-items)
#:listbox-item->text cdr
#:sort-listbox-items? #f
@@ -773,9 +780,12 @@ by pressing the Exit button.~%~%")))
(user-partitions (run-page non-install-devices))
(user-partitions-with-pass (prompt-luks-passwords
user-partitions))
- (form (draw-formatting-page)))
+ (form (draw-formatting-page user-partitions)))
;; Make sure the disks are not in use before proceeding to formatting.
(free-parted non-install-devices)
(format-user-partitions user-partitions-with-pass)
+ (syslog "formatted ~a user partitions~%"
+ (length user-partitions-with-pass))
+
(destroy-form-and-pop form)
user-partitions))
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 6d431cb4bb..ae249ba972 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -77,6 +77,7 @@ system.")
We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \
client may be enough for a server.")
#:info-textbox-width 70
+ #:listbox-height 7
#:listbox-items (filter (lambda (service)
(eq? 'network-management
(system-service-type service)))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 1b4b2df816..5f461279e2 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -38,6 +38,9 @@
(define info-textbox-width (make-parameter 70))
(define options-listbox-height (make-parameter 5))
+(define (display-logo?)
+ (> (screen-rows) 35))
+
(define* (run-menu-page title info-text logo
#:key
listbox-items
@@ -55,7 +58,10 @@ we want this page to occupy all the screen space available."
items))
(let* ((logo-textbox
- (make-textbox -1 -1 (logo-width) (logo-height) 0))
+ (make-textbox -1 -1
+ (if (display-logo?) (logo-width) 0)
+ (if (display-logo?) (logo-height) 0)
+ 0))
(info-textbox
(make-reflowed-textbox -1 -1
info-text
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
index 3fd5756b99..f5d8f1fdbf 100644
--- a/gnu/installer/newt/wifi.scm
+++ b/gnu/installer/newt/wifi.scm
@@ -165,7 +165,8 @@ of <service-item> records present in LISTBOX."
(define service-name-max-length (make-parameter 20))
;; Height of the listbox displaying wifi services.
-(define wifi-listbox-height (make-parameter 20))
+(define wifi-listbox-height (make-parameter
+ (default-listbox-height)))
;; Information textbox width.
(define info-textbox-width (make-parameter 40))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index b0c73b837e..f2352c5779 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -36,6 +36,7 @@
#:use-module (guix utils)
#:use-module (guix i18n)
#:use-module (parted)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (rnrs io ports)
@@ -526,56 +527,54 @@ determined by MAX-LENGTH-COLUMN procedure."
(size (user-partition-size user-partition))
(mount-point (user-partition-mount-point user-partition)))
`(,@(if has-name?
- `((name . ,(string-append "Name: " (or name "None"))))
+ `((name . ,(format #f (G_ "Name: ~a")
+ (or name (G_ "None")))))
'())
,@(if (and has-extended?
(freespace-partition? partition)
(not (eq? type 'logical)))
- `((type . ,(string-append "Type: " type-name)))
+ `((type . ,(format #f (G_ "Type: ~a") type-name)))
'())
,@(if (eq? type 'extended)
'()
- `((fs-type . ,(string-append "Filesystem type: " fs-type-name))))
+ `((fs-type . ,(format #f (G_ "File system type: ~a")
+ fs-type-name))))
,@(if (or (eq? type 'extended)
(eq? fs-type 'swap)
(not has-extended?))
'()
- `((bootable . ,(string-append "Bootable flag: "
- (if bootable? "On" "Off")))))
+ `((bootable . ,(format #f (G_ "Bootable flag: ~:[off~;on~]")
+ bootable?))))
,@(if (and (not has-extended?)
(not (eq? fs-type 'swap)))
- `((esp? . ,(string-append "ESP flag: "
- (if esp? "On" "Off"))))
+ `((esp? . ,(format #f (G_ "ESP flag: ~:[off~;on~]") esp?)))
'())
,@(if (freespace-partition? partition)
(let ((size-formatted
- (or size (unit-format device
+ (or size (unit-format device ;XXX: i18n
(partition-length partition)))))
- `((size . ,(string-append "Size : " size-formatted))))
+ `((size . ,(format #f (G_ "Size: ~a") size-formatted))))
'())
,@(if (or (eq? type 'extended)
(eq? fs-type 'swap))
'()
`((crypt-label
- . ,(string-append
- "Encryption: "
- (if crypt-label
- (format #f "Yes (label ~a)" crypt-label)
- "No")))))
+ . ,(format #f (G_ "Encryption: ~:[No~a~;Yes (label '~a')~]")
+ crypt-label (or crypt-label "")))))
,@(if (or (freespace-partition? partition)
(eq? fs-type 'swap))
'()
`((need-formatting?
- . ,(string-append "Format the partition? : "
- (if need-formatting? "Yes" "No")))))
+ . ,(format #f (G_ "Format the partition? ~:[No~;Yes~]")
+ need-formatting?))))
,@(if (or (eq? type 'extended)
(eq? fs-type 'swap))
'()
`((mount-point
- . ,(string-append "Mount point : "
- (or mount-point
- (and esp? (default-esp-mount-point))
- "None"))))))))
+ . ,(format #f (G_ "Mount point: ~a")
+ (or mount-point
+ (and esp? (default-esp-mount-point))
+ (G_ "None")))))))))
;;
@@ -911,13 +910,13 @@ exists."
(let* ((start-partition
(and (not has-extended?)
- (not esp-partition)
(if (efi-installation?)
- (user-partition
- (fs-type 'fat32)
- (esp? #t)
- (size new-esp-size)
- (mount-point (default-esp-mount-point)))
+ (and (not esp-partition)
+ (user-partition
+ (fs-type 'fat32)
+ (esp? #t)
+ (size new-esp-size)
+ (mount-point (default-esp-mount-point))))
(user-partition
(fs-type 'ext4)
(bootable? #t)
@@ -1327,7 +1326,12 @@ USER-PARTITIONS, or return nothing."
,@(initrd-configuration user-partitions)
,@(if (null? swap-devices)
'()
- `((swap-devices (list ,@swap-devices))))
+ (let* ((uuids (map (lambda (file)
+ (uuid->string (read-partition-uuid file)))
+ swap-devices)))
+ `((swap-devices (list ,@(map (lambda (uuid)
+ `(uuid ,uuid))
+ uuids))))))
,@(if (null? encrypted-partitions)
'()
`((mapped-devices
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 16d74c207f..fdcfb0cb4d 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -50,7 +50,6 @@
%installer-configuration-file
%installer-target-dir
- %configuration-file-width
format-configuration
configuration->file))
@@ -218,7 +217,6 @@ stored in RESULTS. Return #f otherwise."
(define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
(define %installer-target-dir (make-parameter "/mnt"))
-(define %configuration-file-width (make-parameter 79))
(define (format-configuration steps results)
"Return the list resulting from the application of the procedure defined in
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 58bf0a2700..f318546a2f 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -286,8 +286,9 @@ instrumented for further testing."
edit-configuration-file))
"Converse over PORT to choose the partitioning method. When ENCRYPTED? is
true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
-This conversation goes past the final dialog box that shows the configuration
-file, actually starting the installation process."
+This conversation stops when the user partitions have been formatted, right
+before the installer generates the configuration file and shows it in a dialog
+box."
(converse port
((list-selection (title "Partitioning method")
(multiple-choices? #f)
@@ -330,15 +331,29 @@ file, actually starting the installation process."
#t)
((info (title "Preparing partitions") _ ...)
(values)) ;nothing to return
- ((file-dialog (title "Configuration file")
- (text _)
- (file ,configuration-file))
- (edit-configuration-file configuration-file))))
+ ((starting-final-step)
+ ;; Do not return anything. The reply will be sent by
+ ;; 'conclude-installation' and in the meantime the installer just waits
+ ;; for us, giving us a chance to do things such as changing partition
+ ;; UUIDs before it generates the configuration file.
+ (values))))
(define (conclude-installation port)
- "Conclude the installation by checking over PORT that we get the final
-messages once the 'guix system init' process has completed."
+ "Conclude the installation by checking over PORT that we get the generated
+configuration file, accepting it and starting the installation, and then
+receiving the final messages once the 'guix system init' process has
+completed."
+ ;; Assume the previous message received was 'starting-final-step'; here we
+ ;; send the reply to that message, which lets the installer continue.
+ (write #t port)
+ (newline port)
+ (force-output port)
+
(converse port
+ ((file-dialog (title "Configuration file")
+ (text _)
+ (file ,configuration-file))
+ (edit-configuration-file configuration-file))
((pause) ;"Press Enter to continue."
#t)
((installation-complete) ;congratulations!
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-10 11:00:59 +0000