diff options
| -rw-r--r-- | gnu/installer.scm | 51 | ||||
| -rw-r--r-- | gnu/installer/final.scm | 36 | ||||
| -rw-r--r-- | gnu/installer/locale.scm | 13 | ||||
| -rw-r--r-- | gnu/installer/newt.scm | 5 | ||||
| -rw-r--r-- | gnu/installer/newt/final.scm | 84 | ||||
| -rw-r--r-- | gnu/installer/record.scm | 3 | ||||
| -rw-r--r-- | gnu/installer/steps.scm | 68 | ||||
| -rw-r--r-- | gnu/installer/timezone.scm | 12 | ||||
| -rw-r--r-- | gnu/local.mk | 2 |
9 files changed, 249 insertions, 25 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index b3eb2a6b08..e53acb12f4 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -129,7 +129,8 @@ been performed at build time." #:supported-locales #$locales-loader #:iso639-languages #$iso639-loader #:iso3166-territories #$iso3166-loader))) - (#$apply-locale result))))) + (#$apply-locale result) + result)))) (define apply-keymap ;; Apply the specified keymap. @@ -176,17 +177,19 @@ selected keymap." ;; benefit from any available translation for the installer messages. (installer-step (id 'locale) - (description (G_ "Locale selection")) + (description (G_ "Locale")) (compute (lambda _ - (#$locale-step current-installer)))) + (#$locale-step current-installer))) + (configuration-formatter locale->configuration)) ;; Ask the user to select a timezone under glibc format. (installer-step (id 'timezone) - (description (G_ "Timezone selection")) + (description (G_ "Timezone")) (compute (lambda _ ((installer-timezone-page current-installer) - #$timezone-data)))) + #$timezone-data))) + (configuration-formatter posix-tz->configuration)) ;; The installer runs in a kmscon virtual terminal where loadkeys ;; won't work. kmscon uses libxkbcommon as a backend for keyboard @@ -205,9 +208,10 @@ selected keymap." ;; Ask the user to input a hostname for the system. (installer-step (id 'hostname) - (description (G_ "Hostname selection")) + (description (G_ "Hostname")) (compute (lambda _ - ((installer-hostname-page current-installer))))) + ((installer-hostname-page current-installer)))) + (configuration-formatter hostname->configuration)) ;; Provide an interface above connmanctl, so that the user can select ;; a network susceptible to acces Internet. @@ -219,10 +223,22 @@ selected keymap." ;; Prompt for users (name, group and home directory). (installer-step - (id 'hostname) - (description (G_ "User selection")) + (id 'user) + (description (G_ "User creation")) + (compute (lambda _ + ((installer-user-page current-installer)))) + (configuration-formatter users->configuration)) + (compute (lambda _ - ((installer-user-page current-installer))))))))) + ((installer-user-page current-installer))))) + + (installer-step + (id 'final) + (description (G_ "Configuration file")) + (compute + (lambda (result prev-steps) + ((installer-final-page current-installer) + result prev-steps))))))) (define (installer-program) "Return a file-like object that runs the given INSTALLER." @@ -255,7 +271,12 @@ selected keymap." (use-modules (gnu installer record) (gnu installer keymap) (gnu installer steps) + (gnu installer final) (gnu installer locale) + (gnu installer parted) + (gnu installer services) + (gnu installer timezone) + (gnu installer user) (gnu installer newt) (guix i18n) (guix build utils) @@ -268,7 +289,8 @@ selected keymap." ;; Add some binaries used by the installers to PATH. #$set-installer-path - (let ((current-installer newt-installer)) + (let* ((current-installer newt-installer) + (steps (#$steps current-installer))) ((installer-init current-installer)) (catch #t @@ -276,7 +298,7 @@ selected keymap." (run-installer-steps #:rewind-strategy 'menu #:menu-proc (installer-menu-page current-installer) - #:steps (#$steps current-installer))) + #:steps steps)) (const #f) (lambda (key . args) ((installer-exit-error current-installer) key args) @@ -289,8 +311,9 @@ selected keymap." (print-exception port (stack-ref (make-stack #t) 1) key args))) - (primitive-exit 1)))) - ((installer-exit current-installer)))))) + (primitive-exit 1))) + + ((installer-exit current-installer))))))) (program-file "installer" diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm new file mode 100644 index 0000000000..e1c62f5ce0 --- /dev/null +++ b/gnu/installer/final.scm @@ -0,0 +1,36 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (gnu installer final) + #:use-module (gnu installer newt page) + #:use-module (gnu installer steps) + #:use-module (gnu installer utils) + #:use-module (gnu services herd) + #:use-module (guix build utils) + #:export (install-system)) + +(define (install-system) + "Start COW-STORE service on target directory and launch guix install command +in a subshell." + (let ((install-command + (format #f "guix system init ~a ~a" + (%installer-configuration-file) + (%installer-target-dir)))) + (mkdir-p (%installer-target-dir)) + (start-service 'cow-store (list (%installer-target-dir))) + (false-if-exception (run-shell-command install-command)))) diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm index 504070d41d..2b45b2200a 100644 --- a/gnu/installer/locale.scm +++ b/gnu/installer/locale.scm @@ -35,7 +35,9 @@ language-code->language-name iso3166->iso3166-territories - territory-code->territory-name)) + territory-code->territory-name + + locale->configuration)) ;;; @@ -197,3 +199,12 @@ territory name corresponding to the given TERRITORY-CODE." territory-code))) territories))) (iso3166-territory-name iso3166-territory))) + + +;;; +;;; Configuration formatter. +;;; + +(define (locale->configuration locale) + "Return the configuration field for LOCALE." + `((locale ,locale))) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index db57c732d1..77a7e6dca2 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -19,6 +19,7 @@ (define-module (gnu installer newt) #:use-module (gnu installer record) #:use-module (gnu installer newt ethernet) + #:use-module (gnu installer newt final) #:use-module (gnu installer newt hostname) #:use-module (gnu installer newt keymap) #:use-module (gnu installer newt locale) @@ -46,6 +47,9 @@ (define (exit-error key . args) (newt-finish)) +(define (final-page result prev-steps) + (run-final-page result prev-steps)) + (define* (locale-page #:key supported-locales iso639-languages @@ -83,6 +87,7 @@ (init init) (exit exit) (exit-error exit-error) + (final-page final-page) (keymap-page keymap-page) (locale-page locale-page) (menu-page menu-page) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm new file mode 100644 index 0000000000..023777cc0a --- /dev/null +++ b/gnu/installer/newt/final.scm @@ -0,0 +1,84 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(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 (newt) + #:export (run-final-page)) + +(define (run-config-display-page) + (let ((width (%configuration-file-width)) + (height (nearest-exact-integer + (/ (screen-rows) 2)))) + (run-file-textbox-page + #:info-text (G_ "Congratulations, the installation is almost over! A \ +system configuration file has been generated, it is displayed just below. The \ +new system will be created from this file when pression the Ok button.") + #:title (G_ "Configuration file") + #:file (%installer-configuration-file) + #:info-textbox-width width + #:file-textbox-width width + #:file-textbox-height height + #:cancel-button-callback-procedure + (lambda () + (raise + (condition + (&installer-step-abort))))))) + +(define (run-install-success-page) + (message-window + (G_ "Installation complete") + (G_ "Reboot") + (G_ "The installation finished with success. You may now remove the device \ +with the installation image and press the button to reboot."))) + +(define (run-install-failed-page) + (choice-window + (G_ "Installation failed") + (G_ "Restart installer") + (G_ "Retry system install") + (G_ "The final system installation step failed. You can retry the \ +last step, or restart the installer."))) + +(define (run-install-shell) + (clear-screen) + (newt-suspend) + (let ((install-ok? (install-system))) + (newt-resume) + install-ok?)) + +(define (run-final-page result prev-steps) + (let* ((configuration (format-configuration prev-steps result)) + (user-partitions (result-step result 'partition)) + (install-ok? + (with-mounted-partitions + user-partitions + (configuration->file configuration) + (run-config-display-page) + (run-install-shell)))) + (if install-ok? + (run-install-success-page) + (run-install-failed-page)))) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index 9c10c65758..bf74040699 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -27,6 +27,7 @@ installer-init installer-exit installer-exit-error + installer-final-page installer-keymap-page installer-locale-page installer-menu-page @@ -57,6 +58,8 @@ ;; procedure (key arguments) -> void (exit-error installer-exit-error) ;; procedure (#:key models layouts) -> (list model layout variant) + ;; procedure void -> void + (final-page installer-final-page) (keymap-page installer-keymap-page) ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) ;; -> glibc-locale diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 5fd54356dd..3f0bdad4f7 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -18,10 +18,13 @@ (define-module (gnu installer steps) #:use-module (guix records) + #:use-module (guix build utils) #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (rnrs io ports) #:export (&installer-step-abort installer-step-abort? @@ -35,13 +38,19 @@ installer-step-id installer-step-description installer-step-compute - installer-step-configuration-proc + installer-step-configuration-formatter run-installer-steps find-step-by-id result->step-ids result-step - result-step-done?)) + result-step-done? + + %installer-configuration-file + %installer-target-dir + %configuration-file-width + format-configuration + configuration->file)) ;; This condition may be raised to abort the current step. (define-condition-type &installer-step-abort &condition @@ -60,12 +69,12 @@ (define-record-type* <installer-step> installer-step make-installer-step installer-step? - (id installer-step-id) ;symbol - (description installer-step-description ;string - (default #f)) - (compute installer-step-compute) ;procedure - (configuration-format-proc installer-step-configuration-proc ;procedure - (default #f))) + (id installer-step-id) ;symbol + (description installer-step-description ;string + (default #f)) + (compute installer-step-compute) ;procedure + (configuration-formatter installer-step-configuration-formatter ;procedure + (default #f))) (define* (run-installer-steps #:key steps @@ -157,7 +166,7 @@ return the accumalated result so far." (reverse result))) (let* ((id (installer-step-id step)) (compute (installer-step-compute step)) - (res (compute result))) + (res (compute result done-steps))) (run (alist-cons id res result) #:todo-steps rest-steps #:done-steps (append done-steps (list step)))))))) @@ -185,3 +194,44 @@ RESULTS." "Return #t if the installer-step specified by STEP-ID has a COMPUTE value stored in RESULTS. Return #f otherwise." (and (assoc step-id results) #t)) + +(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 +CONFIGURATION-FORMATTER field of <installer-step> on the associated result +found in RESULTS." + (let ((configuration + (append-map + (lambda (step) + (let* ((step-id (installer-step-id step)) + (conf-formatter + (installer-step-configuration-formatter step)) + (result-step (result-step results step-id))) + (if (and result-step conf-formatter) + (conf-formatter result-step) + '()))) + steps)) + (modules '((use-modules (gnu)) + (use-service-modules desktop)))) + `(,@modules + () + (operating-system ,@configuration)))) + +(define* (configuration->file configuration + #:key (filename (%installer-configuration-file))) + "Write the given CONFIGURATION to FILENAME." + (mkdir-p (dirname filename)) + (call-with-output-file filename + (lambda (port) + (format port ";; This is an operating system configuration generated~%") + (format port ";; by the graphical installer.~%") + (newline port) + (for-each (lambda (part) + (if (null? part) + (newline port) + (pretty-print part port))) + configuration) + (flush-output-port port)))) diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm index 061e8c2e48..32bc2ed6bb 100644 --- a/gnu/installer/timezone.scm +++ b/gnu/installer/timezone.scm @@ -28,7 +28,8 @@ #:export (locate-childrens timezone->posix-tz timezone-has-child? - zonetab->timezone-tree)) + zonetab->timezone-tree + posix-tz->configuration)) (define %not-blank (char-set-complement char-set:blank)) @@ -115,3 +116,12 @@ TREE. Raise a condition if the PATH could not be found." (define* (zonetab->timezone-tree zonetab) "Return the timezone tree corresponding to the given ZONETAB file." (timezones->timezone-tree (zonetab->timezones zonetab))) + + +;;; +;;; Configuration formatter. +;;; + +(define (posix-tz->configuration timezone) + "Return the configuration field for TIMEZONE." + `((timezone ,timezone))) diff --git a/gnu/local.mk b/gnu/local.mk index b0ec16de34..d4acb8d2ec 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -569,6 +569,7 @@ GNU_SYSTEM_MODULES += \ %D%/installer.scm \ %D%/installer/record.scm \ %D%/installer/connman.scm \ + %D%/installer/final.scm \ %D%/installer/keymap.scm \ %D%/installer/locale.scm \ %D%/installer/newt.scm \ @@ -577,6 +578,7 @@ GNU_SYSTEM_MODULES += \ %D%/installer/utils.scm \ \ %D%/installer/newt/ethernet.scm \ + %D%/installer/newt/final.scm \ %D%/installer/newt/hostname.scm \ %D%/installer/newt/keymap.scm \ %D%/installer/newt/locale.scm \ |