;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Mathieu Othacehe ;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu installer newt final) #:use-module (gnu installer final) #:use-module (gnu installer parted) #:use-module (gnu installer steps) #:use-module (gnu installer utils) #:use-module (gnu installer newt page) #:use-module (gnu installer newt utils) #:use-module (guix i18n) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (newt) #:export (run-final-page)) (define* (strip-prefix file #:optional (prefix (%installer-target-dir))) "Strip PREFIX from FILE, if PREFIX actually is a prefix of FILE." (if (string-prefix? prefix file) (string-drop file (string-length prefix)) file)) (define* (run-config-display-page #:key locale) (let ((width (%configuration-file-width)) (height (nearest-exact-integer (/ (screen-rows) 2)))) (run-file-textbox-page #:info-text (format #f (G_ "\ We're now ready to proceed with the installation! \ A system configuration file has been generated, it is displayed below. \ This file will be available as '~a' on the installed system. \ The new system will be created from this file once you've pressed OK. \ This will take a few minutes.") (strip-prefix (%installer-configuration-file))) #:title (G_ "Configuration file") #:file (%installer-configuration-file) #:edit-button? #t #:editor-locale locale #:info-textbox-width width #:file-textbox-width width #:file-textbox-height height #:exit-button-callback-procedure (lambda () (raise (condition (&installer-step-abort))))))) (define (run-install-success-page) (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."))) (_ ;; 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 (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. #t))) (_ (send-to-clients '(installation-failure)) #t))) (define* (run-install-shell locale #:key (users '())) (clear-screen) (newt-suspend) (let ((install-ok? (install-system locale #:users users))) (newt-resume) install-ok?)) (define (run-final-page result prev-steps) (let* ((configuration (format-configuration prev-steps result)) (user-partitions (result-step result 'partition)) (locale (result-step result 'locale)) (users (result-step result 'user)) (install-ok? (with-mounted-partitions user-partitions (configuration->file configuration) (run-config-display-page #:locale locale) (run-install-shell locale #:users users)))) (if install-ok? (run-install-success-page) (run-install-failed-page)))) -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. 2020-02-22installer: Log important bits to syslog.Ludovic Courtès * gnu/installer.scm (installer-program): Log crashes with 'syslog'. * gnu/installer/parted.scm (luks-format-and-open, luks-close) (mount-user-partitions, umount-user-partitions): Add 'syslog' calls. * gnu/installer/steps.scm (run-installer-steps): Log the running step with 'syslog'. * gnu/installer/utils.scm (run-shell-command): Add calls to 'syslog'. 2020-02-22installer: Add 'syslog' macro to write to syslog.Ludovic Courtès * gnu/installer/utils.scm (open-syslog-port, syslog-port): New procedures. (syslog): New macro.