diff options
Diffstat (limited to 'gnu/installer/newt')
| -rw-r--r-- | gnu/installer/newt/final.scm | 8 | ||||
| -rw-r--r-- | gnu/installer/newt/network.scm | 11 | ||||
| -rw-r--r-- | gnu/installer/newt/page.scm | 12 | ||||
| -rw-r--r-- | gnu/installer/newt/partition.scm | 18 | ||||
| -rw-r--r-- | gnu/installer/newt/substitutes.scm | 2 | ||||
| -rw-r--r-- | gnu/installer/newt/welcome.scm | 60 |
6 files changed, 92 insertions, 19 deletions
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index 7c3f73ee82..9f950a0551 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -80,16 +80,20 @@ press the button to reboot."))) (define (run-install-failed-page) (match (current-clients) (() - (match (choice-window + (match (ternary-window (G_ "Installation failed") (G_ "Resume") (G_ "Restart the installer") + (G_ "Report the failure") (G_ "The final system installation step failed. You can resume from \ a specific step, or restart the installer.")) (1 (abort-to-prompt 'installer-step 'abort)) (2 ;; Keep going, the installer will be restarted later on. - #t))) + #t) + (3 (raise + (condition + (&user-abort-error)))))) (_ (send-to-clients '(installation-failure)) #t))) diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index 0477a489be..ba26fc7c76 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -115,6 +115,11 @@ network devices were found. Do you want to continue anyway?")) (define (wait-service-online) "Display a newt scale until connman detects an Internet access. Do FULL-VALUE tentatives, spaced by 1 second." + (define (url-alive? url) + (false-if-exception + (= (response-code (http-request url)) + 200))) + (define (ci-available?) (dynamic-wind (lambda () @@ -122,10 +127,8 @@ FULL-VALUE tentatives, spaced by 1 second." (lambda _ #f)) (alarm 3)) (lambda () - (false-if-exception - (= (response-code - (http-request "https://ci.guix.gnu.org")) - 200))) + (or (url-alive? "https://ci.guix.gnu.org") + (url-alive? "https://bordeaux.guix.gnu.org"))) (lambda () (alarm 0)))) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 0f508a31c0..e1623a51fd 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. @@ -278,12 +278,12 @@ input box, such as FLAG-PASSWORD." (destroy-form-and-pop form) input)))))))) -(define (run-error-page text title) - "Run a page to inform the user of an error. The page contains the given TEXT -to explain the error and an \"OK\" button to acknowledge the error. The title -of the page is set to TITLE." +(define* (run-error-page text title #:key (width 40)) + "Run a page to inform the user of an error. The page is WIDTH column wide +and contains the given TEXT to explain the error and an \"OK\" button to +acknowledge the error. The title of the page is set to TITLE." (let* ((text-box - (make-reflowed-textbox -1 -1 text 40 + (make-reflowed-textbox -1 -1 text width #:flags FLAG-BORDER)) (grid (make-grid 1 2)) (ok-button (make-button -1 -1 "OK")) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 2adb4922b4..37656696c1 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2018, 2019, 2022 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; @@ -92,17 +92,31 @@ disk. The installation device as well as the small devices are filtered.") (device (car result))) device)) +(define (run-label-confirmation-page callback) + (lambda (item) + (match (current-clients) + (() + (and (run-confirmation-page + (format #f (G_ "This will create a new ~a partition table, \ +all data on disk will be lost, are you sure you want to proceed?") item) + (G_ "Format disk?") + #:exit-button-procedure callback) + item)) + (_ item)))) + (define (run-label-page button-text button-callback) "Run a page asking the user to select a partition table label." ;; Force the GPT label if UEFI is supported. (if (efi-installation?) - "gpt" + ((run-label-confirmation-page button-callback) "gpt") (run-listbox-selection-page #:info-text (G_ "Select a new partition table type. \ Be careful, all data on the disk will be lost.") #:title (G_ "Partition table") #:listbox-items '("msdos" "gpt") #:listbox-item->text identity + #:listbox-callback-procedure + (run-label-confirmation-page button-callback) #:button-text button-text #:button-callback-procedure button-callback))) diff --git a/gnu/installer/newt/substitutes.scm b/gnu/installer/newt/substitutes.scm index 938cb1a53b..7599d450b6 100644 --- a/gnu/installer/newt/substitutes.scm +++ b/gnu/installer/newt/substitutes.scm @@ -28,7 +28,7 @@ (match (current-clients) (() (case (choice-window - (G_ "Substitute server discovery.") + (G_ "Substitute server discovery") (G_ "Enable") (G_ "Disable") (G_ " By turning this option on, you allow Guix to fetch \ substitutes (pre-built binaries) during installation from servers \ diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm index 7a7ddfb7bd..f821374cb7 100644 --- a/gnu/installer/newt/welcome.scm +++ b/gnu/installer/newt/welcome.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020, 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022 Florian Pelz <pelzflorian@pelzflorian.de> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,6 +18,11 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu installer newt welcome) + #:use-module ((gnu build linux-modules) + #:select (modules-loaded + pci-devices)) + #:use-module (gnu installer dump) + #:use-module (gnu installer hardware) #:use-module (gnu installer steps) #:use-module (gnu installer utils) #:use-module (gnu installer newt page) @@ -26,6 +32,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 receive) #:use-module (newt) @@ -117,10 +125,52 @@ we want this page to occupy all the screen space available." (lambda () (destroy-form-and-pop form)))))) -(define (run-welcome-page logo) +(define (check-hardware-support pci-database) + "Warn about unsupported devices." + (when (member "uvesafb" (modules-loaded)) + (run-error-page (G_ "\ +This may be a false alarm, but possibly your graphics hardware does not +work well with only free software. Expect trouble. If after installation, +the system does not boot, perhaps you will need to add nomodeset to the +kernel arguments and need to configure the uvesafb kernel module.") + (G_ "Pre-install warning"))) + + (let ((devices (pci-devices))) + (match (filter unsupported-pci-device? devices) + (() ;no unsupported device + #t) + (unsupported + (run-error-page (format #f (G_ "\ +Devices not supported by free software were found on your computer: + +~{ - ~a~%~} +Unfortunately, it means those devices will not be usable. + +To address it, we recommend choosing hardware that respects your freedom as a \ +user--hardware for which free drivers and firmware exist. See \"Hardware \ +Considerations\" in the manual for more information.") + (map (pci-device-description pci-database) + unsupported)) + (G_ "Hardware support warning") + #:width 76))))) + +(define* (run-welcome-page logo #:key pci-database) "Run a welcome page with the given textual LOGO displayed at the center of the page. Ask the user to choose between manual installation, graphical installation and reboot." + (when (file-exists? %core-dump) + (match (choice-window + (G_ "Previous installation failed") + (G_ "Continue") + (G_ "Report the failure") + (G_ "It seems that the previous installation exited unexpectedly \ +and generated a core dump. Do you want to continue or to report the failure \ +first?")) + (1 #t) + (2 (raise + (condition + (&user-abort-error)))))) + (run-menu-page (G_ "GNU Guix install") (G_ "Welcome to GNU Guix system installer! @@ -134,14 +184,16 @@ Documentation is accessible at any time by pressing Ctrl-Alt-F2.") #:listbox-items `((,(G_ "Graphical install using a terminal based interface") . - ,(const #t)) + ,(lambda () + (check-hardware-support pci-database))) (,(G_ "Install using the shell based process") . ,(lambda () + (check-hardware-support pci-database) ;; Switch to TTY3, where a root shell is available for shell based ;; install. The other root TTY's would have been ok too. (system* "chvt" "3") - (run-welcome-page logo))) + (run-welcome-page logo #:pci-database pci-database))) (,(G_ "Reboot") . ,(lambda () |