X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/a49d633c0c65975263270f5ac0050482ca6a5513..5ead32ddf10e9af50174b4ee2c7684adcbd86b8e:/gnu/installer.scm diff --git a/gnu/installer.scm b/gnu/installer.scm index 9e773ee8f0..1676a91801 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -1,5 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe +;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,6 +19,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu installer) + #:use-module (guix discovery) #:use-module (guix packages) #:use-module (guix gexp) #:use-module (guix modules) @@ -27,24 +30,33 @@ #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages connman) + #:use-module (gnu packages cryptsetup) + #:use-module (gnu packages disk) + #:use-module (gnu packages file-systems) #:use-module (gnu packages guile) + #:use-module (gnu packages guile-xyz) #:autoload (gnu packages gnupg) (guile-gcrypt) #:use-module (gnu packages iso-codes) #:use-module (gnu packages linux) #:use-module (gnu packages ncurses) #:use-module (gnu packages package-management) #:use-module (gnu packages xorg) + #:use-module (gnu system locale) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:export (installer-program)) -(define not-config? - ;; Select (guix …) and (gnu …) modules, except (guix config). +(define module-to-import? + ;; Return true for modules that should be imported. For (gnu system …) and + ;; (gnu packages …) modules, we simply add the whole 'guix' package via + ;; 'with-extensions' (to avoid having to rebuild it all), which is why these + ;; modules are excluded here. (match-lambda (('guix 'config) #f) - (('guix rest ...) #t) - (('gnu rest ...) #t) - (rest #f))) + (('gnu 'installer _ ...) #t) + (('gnu 'build _ ...) #t) + (('guix 'build _ ...) #t) + (_ #f))) (define* (build-compiled-file name locale-builder) "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store @@ -59,7 +71,7 @@ version of this file." (setlocale LC_ALL "en_US.utf8"))) (define builder - (with-extensions (list guile-json) + (with-extensions (list guile-json-3) (with-imported-modules (source-module-closure '((gnu installer locale))) #~(begin @@ -82,9 +94,17 @@ version of this file." (define apply-locale ;; Install the specified locale. - #~(lambda (locale-name) - (false-if-exception - (setlocale LC_ALL locale-name)))) + (with-imported-modules (source-module-closure '((gnu services herd))) + #~(lambda (locale) + (false-if-exception + (setlocale LC_ALL locale)) + + ;; Restart the documentation viewer so it displays the manual in + ;; language that corresponds to LOCALE. + (with-error-to-port (%make-void-port "w") + (lambda () + (stop-service 'term-tty2) + (start-service 'term-tty2 (list locale))))))) (define* (compute-locale-step #:key locales-name @@ -101,7 +121,7 @@ been performed at build time." (string-append #$file "/" #$name ".go"))) (let* ((supported-locales #~(supported-locales->locales - #$(local-file "installer/aux-files/SUPPORTED"))) + #+(glibc-supported-locales))) (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/")) (iso639-3 #~(string-append #$iso-codes "iso_639-3.json")) (iso639-5 #~(string-append #$iso-codes "iso_639-5.json")) @@ -129,13 +149,15 @@ 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. + ;; Apply the specified keymap. Use the default keyboard model. #~(match-lambda - ((model layout variant) - (kmscon-update-keymap model layout variant)))) + ((layout variant) + (kmscon-update-keymap (default-keyboard-model) + layout variant)))) (define* (compute-keymap-step) "Return a gexp that runs the keymap-page of INSTALLER and install the @@ -149,9 +171,9 @@ selected keymap." "/share/X11/xkb/rules/base.xml"))) (lambda (models layouts) ((installer-keymap-page current-installer) - #:models models - #:layouts layouts))))) - (#$apply-keymap result)))) + layouts))))) + (#$apply-keymap result) + result))) (define (installer-steps) (let ((locale-step (compute-locale-step @@ -163,30 +185,33 @@ selected keymap." "/share/zoneinfo/zone.tab"))) #~(lambda (current-installer) (list - ;; Welcome the user and ask him to choose between manual installation - ;; and graphical install. + ;; Ask the user to choose a locale among those supported by + ;; the glibc. Install the selected locale right away, so that + ;; the user may benefit from any available translation for the + ;; installer messages. (installer-step - (id 'welcome) + (id 'locale) + (description (G_ "Locale")) (compute (lambda _ - ((installer-welcome-page current-installer) - #$(local-file "installer/aux-files/logo.txt"))))) + (#$locale-step current-installer))) + (configuration-formatter locale->configuration)) - ;; Ask the user to choose a locale among those supported by the glibc. - ;; Install the selected locale right away, so that the user may - ;; benefit from any available translation for the installer messages. + ;; Welcome the user and ask them to choose between manual + ;; installation and graphical install. (installer-step - (id 'locale) - (description (G_ "Locale selection")) + (id 'welcome) (compute (lambda _ - (#$locale-step current-installer)))) + ((installer-welcome-page current-installer) + #$(local-file "installer/aux-files/logo.txt"))))) ;; 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 @@ -200,14 +225,16 @@ selected keymap." (id 'keymap) (description (G_ "Keyboard mapping selection")) (compute (lambda _ - (#$keymap-step current-installer)))) + (#$keymap-step current-installer))) + (configuration-formatter keyboard-layout->configuration)) ;; 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 +246,38 @@ 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))))))))) + ((installer-user-page current-installer)))) + (configuration-formatter users->configuration)) + + ;; Ask the user to choose one or many desktop environment(s). + (installer-step + (id 'services) + (description (G_ "Services")) + (compute (lambda _ + ((installer-services-page current-installer)))) + (configuration-formatter system-services->configuration)) + + ;; Run a partitioning tool allowing the user to modify + ;; partition tables, partitions and their mount points. + ;; Do this last so the user has something to boot if any + ;; of the previous steps didn't go as expected. + (installer-step + (id 'partition) + (description (G_ "Partitioning")) + (compute (lambda _ + ((installer-partition-page current-installer)))) + (configuration-formatter user-partitions->configuration)) + + (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." @@ -236,34 +291,61 @@ selected keymap." (define set-installer-path ;; Add the specified binary to PATH for later use by the installer. #~(let* ((inputs - '#$(append (list bash connman shadow) + '#$(append (list bash ;start subshells + connman ;call connmanctl + cryptsetup + dosfstools ;mkfs.fat + e2fsprogs ;mkfs.ext4 + btrfs-progs ;mkfs.btrfs + jfsutils ;jfs_mkfs + kbd ;chvt + guix ;guix system init call + util-linux ;mkwap + shadow) (map canonical-package (list coreutils))))) (with-output-to-port (%make-void-port "w") (lambda () (set-path-environment-variable "PATH" '("bin" "sbin") inputs))))) (define steps (installer-steps)) + (define modules + (scheme-modules* + (string-append (current-source-directory) "/..") + "gnu/installer")) (define installer-builder - (with-extensions (list guile-gcrypt guile-newt guile-json) + ;; Note: Include GUIX as an extension to get all the (gnu system …), (gnu + ;; packages …), etc. modules. + (with-extensions (list guile-gcrypt guile-newt + guile-parted guile-bytestructures + guile-json-3 guile-git guix) (with-imported-modules `(,@(source-module-closure - '((gnu installer newt) + `(,@modules + (gnu services herd) (guix build utils)) - #:select? not-config?) + #:select? module-to-import?) ((guix config) => ,(make-config.scm))) #~(begin (use-modules (gnu installer record) (gnu installer keymap) (gnu installer steps) + (gnu installer final) + (gnu installer hostname) (gnu installer locale) + (gnu installer parted) + (gnu installer services) + (gnu installer timezone) + (gnu installer user) (gnu installer newt) + ((gnu installer newt keymap) + #:select (keyboard-layout->configuration)) + (gnu services herd) (guix i18n) (guix build utils) + ((system repl debug) + #:select (terminal-width)) (ice-9 match)) - ;; Set the default locale to install unicode support. - (setlocale LC_ALL "en_US.utf8") - ;; Initialize gettext support so that installers can use ;; (guix i18n) module. #$init-gettext @@ -271,28 +353,66 @@ selected keymap." ;; Add some binaries used by the installers to PATH. #$set-installer-path - (let ((current-installer newt-installer)) + ;; Arrange for language and territory name translations to be + ;; available. We need them at run time, not just compile time, + ;; because some territories have several corresponding languages + ;; (e.g., "French" is always displayed as "français", but + ;; "Belgium" could be translated to Dutch, French, or German.) + (bindtextdomain "iso_639-3" ;languages + #+(file-append iso-codes "/share/locale")) + (bindtextdomain "iso_3166-1" ;territories + #+(file-append iso-codes "/share/locale")) + + ;; Likewise for XKB keyboard layout names. + (bindtextdomain "xkeyboard-config" + #+(file-append xkeyboard-config "/share/locale")) + + ;; Initialize 'terminal-width' in (system repl debug) + ;; to a large-enough value to make backtrace more + ;; verbose. + (terminal-width 200) + + (let* ((current-installer newt-installer) + (steps (#$steps current-installer))) ((installer-init current-installer)) (catch #t (lambda () - (run-installer-steps - #:rewind-strategy 'menu - #:menu-proc (installer-menu-page current-installer) - #:steps (#$steps current-installer))) + (define results + (run-installer-steps + #:rewind-strategy 'menu + #:menu-proc (installer-menu-page current-installer) + #:steps steps)) + + (match (result-step results 'final) + ('success + ;; We did it! Let's reboot! + (sync) + (stop-service 'root)) + (_ ;installation failed + ;; TODO: Honor the result of 'run-install-failed-page'. + #f))) (const #f) (lambda (key . args) - ((installer-exit-error current-installer) key args) - - ;; Be sure to call newt-finish, to restore the terminal into - ;; its original state before printing the error report. - (call-with-output-file "/tmp/error" - (lambda (port) - (display-backtrace (make-stack #t) port) - (print-exception port - (stack-ref (make-stack #t) 1) - key args))) - (primitive-exit 1)))) - ((installer-exit current-installer)))))) - - (program-file "installer" installer-builder)) + (let ((error-file "/tmp/last-installer-error")) + (call-with-output-file error-file + (lambda (port) + (display-backtrace (make-stack #t) port) + (print-exception port + (stack-ref (make-stack #t) 1) + key args))) + ((installer-exit-error current-installer) + error-file key args)) + (primitive-exit 1))) + + ((installer-exit current-installer))))))) + + (program-file + "installer" + #~(begin + ;; Set the default locale to install unicode support. For + ;; some reason, unicode support is not correctly installed + ;; when calling this in 'installer-builder'. + (setenv "LANG" "en_US.UTF-8") + (execl #$(program-file "installer-real" installer-builder) + "installer-real"))))