lint: Check for trailing whitespace in synopsis.

[jackhill/guix/guix.git] / gnu / installer / tests.scm

diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 6f5393e..8ccd327 100644 (file)
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,7 +37,8 @@
             enter-host-name+passwords
             choose-services
             choose-partitioning
-            conclude-installation
+            start-installation
+            complete-installation
 
             edit-configuration-file))
 
@@ -211,7 +213,7 @@ ROOT-PASSWORD, and USERS."
 
 (define* (choose-services port
                           #:key
-                          (desktop-environments '("GNOME"))
+                          (choose-desktop-environment? (const #f))
                           (choose-network-service?
                            (lambda (service)
                              (or (string-contains service "SSH")
@@ -220,10 +222,14 @@ ROOT-PASSWORD, and USERS."
                            (lambda (service)
                              (string-contains service "DHCP"))))
   "Converse over PORT to choose networking services."
+  (define desktop-environments '())
+
   (converse port
     ((checkbox-list (title "Desktop environment") (text _)
-                    (items _))
-     desktop-environments)
+                    (items ,services))
+     (let ((desktops (filter choose-desktop-environment? services)))
+       (set! desktop-environments desktops)
+       desktops))
     ((checkbox-list (title "Network service") (text _)
                     (items ,services))
      (filter choose-network-service? services))
@@ -276,13 +282,19 @@ instrumented for further testing."
 (define* (choose-partitioning port
                               #:key
                               (encrypted? #t)
+                              (uefi-support? #f)
                               (passphrase "thepassphrase")
                               (edit-configuration-file
                                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."
+
+When UEFI-SUPPORT? is true, assume that we are running the installation tests
+on an UEFI capable machine.
+
+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)
@@ -291,15 +303,24 @@ file, actually starting the installation process."
          encrypted
          not-encrypted))
     ((list-selection (title "Disk") (multiple-choices? #f)
-                     (items (,disk _ ...)))
-     disk)
+                     (items (,disks ...)))
+     ;; When running the installation from an ISO image, the CD/DVD drive
+     ;; shows up in the list.  Avoid it.
+     (find (lambda (disk)
+             (not (or (string-contains disk "DVD")
+                      (string-contains disk "CD-ROM"))))
+           disks))
 
     ;; The "Partition table" dialog pops up only if there's not already a
-    ;; partition table.
+    ;; partition table and if the system does not support UEFI.
     ((list-selection (title "Partition table")
                      (multiple-choices? #f)
                      (items _))
+     ;; When UEFI is supported, the partition is forced to GPT by the
+     ;; installer.
+     (not uefi-support?)
      "gpt")
+
     ((list-selection (title "Partition scheme")
                      (multiple-choices? #f)
                      (items (,one-partition _ ...)))
@@ -320,18 +341,43 @@ file, actually starting the installation process."
      #t)
     ((info (title "Preparing partitions") _ ...)
      (values))                                    ;nothing to return
+    ((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 (start-installation port)
+  "Start the installation by checking over PORT that we get the generated
+configuration file, accepting it and starting the installation, and then
+receiving the pause message 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))))
+     (edit-configuration-file configuration-file))
+    ((pause)                                      ;"Press Enter to continue."
+     (values))))
+
+(define (complete-installation port)
+  "Complete the installation by replying to the installer pause message and
+waiting for the installation-complete message."
+  ;; Assume the previous message received was 'pause'; here we send the reply
+  ;; to that message, which lets the installer continue.
+  (write #t port)
+  (newline port)
+  (force-output port)
 
-(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."
   (converse port
-    ((pause)                                      ;"Press Enter to continue."
-     #t)
-    ((installation-complete)                      ;congratulations!
+    ((installation-complete)
      (values))))
 
 ;;; Local Variables: