summary refs log tree commit diff
path: root/gnu/installer/newt/final.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-22 22:57:14 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-05 23:40:22 +0100
commit63b8c089c1596cd3e814ac13e1a8b3fa45bb2b54 (patch)
treea60aa9c44ad5e7b51ef4621e5b5609f9552cf100 /gnu/installer/newt/final.scm
parent5ce84b1713b847c860345fc9199c44e3e6d513bb (diff)
downloadguix-63b8c089c1596cd3e814ac13e1a8b3fa45bb2b54.tar.gz
installer: Implement a dialog on /var/guix/installer-socket.
This will allow us to automate testing of the installer.

* gnu/installer/utils.scm (%client-socket-file)
(current-server-socket, current-clients): New variables.
(open-server-socket, call-with-server-socket): New procedure.
(with-server-socket): New macro.
(run-shell-command): Add call to 'send-to-clients'.  Select on both
current-input-port and current-clients.
* gnu/installer/steps.scm (run-installer-steps): Wrap 'call-with-prompt'
in 'with-socket-server'.  Call 'sigaction' for SIGPIPE.
* gnu/installer/newt/page.scm (watch-clients!, close-port-and-reuse-fd)
(run-form-with-clients, send-to-clients): New procedures.
(draw-info-page): Add call to 'run-form-with-clients'.
(run-input-page): Likewise.  Handle EXIT-REASON equal to 'exit-fd-ready.
(run-confirmation-page): Likewise.
(run-listbox-selection-page): Likewise.  Define 'choice->item' and use it.
(run-checkbox-tree-page): Likewise.
(run-file-textbox-page): Add call to 'run-form-with-clients'.  Handle
'exit-fd-ready'.
* gnu/installer/newt/partition.scm (run-disk-page): Pass
 #:client-callback-procedure to 'run-listbox-selection-page'.
* gnu/installer/newt/user.scm (run-user-page): Call
'run-form-with-clients'.  Handle 'exit-fd-ready'.
* gnu/installer/newt/welcome.scm (run-menu-page): Define
'choice->item' and use it.  Call 'run-form-with-clients'.
* gnu/installer/newt/final.scm (run-install-success-page)
(run-install-failed-page): When (current-clients) is non-empty, call
'send-to-clients' without displaying a choice window.
Diffstat (limited to 'gnu/installer/newt/final.scm')
-rw-r--r--gnu/installer/newt/final.scm40
1 files changed, 25 insertions, 15 deletions
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 405eee2540..5cb4f6816d 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -63,28 +63,38 @@ This will take a few minutes.")
          (&installer-step-abort)))))))
 
 (define (run-install-success-page)
-  (message-window
-   (G_ "Installation complete")
-   (G_ "Reboot")
-   (G_ "Congratulations!  Installation is now complete.  \
+  (match (current-clients)
+    (()
+     (message-window
+      (G_ "Installation complete")
+      (G_ "Reboot")
+      (G_ "Congratulations!  Installation is now complete.  \
 You may remove the device containing the installation image and \
-press the button to reboot."))
+press the button to reboot.")))
+    (_
+     ;; When there are clients connected, send them a message and keep going.
+     (send-to-clients '(installation-complete))))
 
   ;; Return success so that the installer happily reboots.
   'success)
 
 (define (run-install-failed-page)
-  (match (choice-window
-          (G_ "Installation failed")
-          (G_ "Resume")
-          (G_ "Restart the installer")
-          (G_ "The final system installation step failed.  You can resume from \
+  (match (current-clients)
+    (()
+     (match (choice-window
+             (G_ "Installation failed")
+             (G_ "Resume")
+             (G_ "Restart the installer")
+             (G_ "The final system installation step failed.  You can resume from \
 a specific step, or restart the installer."))
-    (1 (raise
-        (condition
-         (&installer-step-abort))))
-    (2
-     ;; Keep going, the installer will be restarted later on.
+       (1 (raise
+           (condition
+            (&installer-step-abort))))
+       (2
+        ;; Keep going, the installer will be restarted later on.
+        #t)))
+    (_
+     (send-to-clients '(installation-failure))
      #t)))
 
 (define* (run-install-shell locale