X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/850ddf94e86a1711328e39872c7830ad6d5020b4..d80443f7657f7c8a954f74ca3c3610646d3c0304:/gnu/installer.scm diff --git a/gnu/installer.scm b/gnu/installer.scm index 5694cef66f..d2be4b34f9 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -1,6 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Mathieu Othacehe -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2018, 2020 Mathieu Othacehe +;;; Copyright © 2019, 2020 Ludovic Courtès +;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice +;;; Copyright © 2020 Florian Pelz ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,12 +27,16 @@ #:use-module (guix utils) #:use-module (guix ui) #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (guix packages) + #:use-module (guix git-download) + #:use-module (gnu installer utils) #:use-module (gnu packages admin) #: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) @@ -39,6 +45,7 @@ #: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)) @@ -55,8 +62,16 @@ (('guix 'build _ ...) #t) (_ #f))) +(define not-config? + ;; Select (guix …) and (gnu …) modules, except (guix config). + (match-lambda + (('guix 'config) #f) + (('guix _ ...) #t) + (('gnu _ ...) #t) + (_ #f))) + (define* (build-compiled-file name locale-builder) - "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store + "Return a file-like object that evaluates the gexp LOCALE-BUILDER and store its result in the scheme file NAME. The derivation will also build a compiled version of this file." (define set-utf8-locale @@ -68,9 +83,11 @@ version of this file." (setlocale LC_ALL "en_US.utf8"))) (define builder - (with-extensions (list guile-json) - (with-imported-modules (source-module-closure - '((gnu installer locale))) + (with-extensions (list guile-json-3) + (with-imported-modules `(,@(source-module-closure + '((gnu installer locale)) + #:select? not-config?) + ((guix config) => ,(make-config.scm))) #~(begin (use-modules (gnu installer locale)) @@ -91,9 +108,18 @@ 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. Make sure that nothing is + ;; printed on the console. + (parameterize ((shepherd-message-port + (%make-void-port "w"))) + (stop-service 'term-tty2) + (start-service 'term-tty2 (list locale)))))) (define* (compute-locale-step #:key locales-name @@ -110,7 +136,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")) @@ -144,11 +170,11 @@ been performed at build time." (define apply-keymap ;; Apply the specified keymap. Use the default keyboard model. #~(match-lambda - ((layout variant) + ((layout variant options) (kmscon-update-keymap (default-keyboard-model) - layout variant)))) + layout variant options)))) -(define* (compute-keymap-step) +(define* (compute-keymap-step context) "Return a gexp that runs the keymap-page of INSTALLER and install the selected keymap." #~(lambda (current-installer) @@ -160,8 +186,8 @@ selected keymap." "/share/X11/xkb/rules/base.xml"))) (lambda (models layouts) ((installer-keymap-page current-installer) - layouts))))) - (#$apply-keymap result) + layouts '#$context))))) + (and result (#$apply-keymap result)) result))) (define (installer-steps) @@ -169,10 +195,15 @@ selected keymap." #:locales-name "locales" #:iso639-languages-name "iso639-languages" #:iso3166-territories-name "iso3166-territories")) - (keymap-step (compute-keymap-step)) (timezone-data #~(string-append #$tzdata "/share/zoneinfo/zone.tab"))) #~(lambda (current-installer) + ((installer-parameters-menu current-installer) + (lambda () + ((installer-parameters-page current-installer) + (lambda _ + (#$(compute-keymap-step 'param) + current-installer))))) (list ;; Ask the user to choose a locale among those supported by ;; the glibc. Install the selected locale right away, so that @@ -204,28 +235,21 @@ selected keymap." ;; The installer runs in a kmscon virtual terminal where loadkeys ;; won't work. kmscon uses libxkbcommon as a backend for keyboard - ;; input. It is possible to update kmscon current keymap by sending it - ;; a keyboard model, layout and variant, in a somehow similar way as - ;; what is done with setxkbmap utility. + ;; input. It is possible to update kmscon current keymap by sending + ;; it a keyboard model, layout, variant and options, in a somehow + ;; similar way as what is done with setxkbmap utility. ;; ;; So ask for a keyboard model, layout and variant to update the - ;; current kmscon keymap. + ;; current kmscon keymap. For non-Latin layouts, we add an + ;; appropriate second layout and toggle via Alt+Shift. (installer-step (id 'keymap) (description (G_ "Keyboard mapping selection")) (compute (lambda _ - (#$keymap-step current-installer))) + (#$(compute-keymap-step 'default) + current-installer))) (configuration-formatter keyboard-layout->configuration)) - ;; Run a partitioning tool allowing the user to modify - ;; partition tables, partitions and their mount points. - (installer-step - (id 'partition) - (description (G_ "Partitioning")) - (compute (lambda _ - ((installer-partition-page current-installer)))) - (configuration-formatter user-partitions->configuration)) - ;; Ask the user to input a hostname for the system. (installer-step (id 'hostname) @@ -242,6 +266,13 @@ selected keymap." (compute (lambda _ ((installer-network-page current-installer))))) + ;; Ask whether to enable substitute server discovery. + (installer-step + (id 'substitutes) + (description (G_ "Substitute server discovery")) + (compute (lambda _ + ((installer-substitutes-page current-installer))))) + ;; Prompt for users (name, group and home directory). (installer-step (id 'user) @@ -256,10 +287,20 @@ selected keymap." (description (G_ "Services")) (compute (lambda _ ((installer-services-page current-installer)))) - (configuration-formatter - desktop-environments->configuration)) + (configuration-formatter system-services->configuration)) - (installer-step + ;; 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 @@ -274,21 +315,26 @@ selected keymap." ;; translated. #~(begin (bindtextdomain "guix" (string-append #$guix "/share/locale")) - (textdomain "guix"))) + (textdomain "guix") + (setlocale LC_ALL ""))) (define set-installer-path ;; Add the specified binary to PATH for later use by the installer. #~(let* ((inputs - '#$(append (list bash ;start subshells - connman ;call connmanctl - cryptsetup - dosfstools ;mkfs.fat - e2fsprogs ;mkfs.ext4 - kbd ;chvt - guix ;guix system init call - util-linux ;mkwap - shadow) - (map canonical-package (list coreutils))))) + '#$(list bash ;start subshells + connman ;call connmanctl + cryptsetup + dosfstools ;mkfs.fat + e2fsprogs ;mkfs.ext4 + lvm2-static ;dmsetup + btrfs-progs + jfsutils ;jfs_mkfs + ntfs-3g ;mkfs.ntfs + kbd ;chvt + guix ;guix system init call + util-linux ;mkwap + shadow + coreutils))) (with-output-to-port (%make-void-port "w") (lambda () (set-path-environment-variable "PATH" '("bin" "sbin") inputs))))) @@ -304,9 +350,10 @@ selected keymap." ;; packages …), etc. modules. (with-extensions (list guile-gcrypt guile-newt guile-parted guile-bytestructures - guile-json guile-git guix) + guile-json-3 guile-git guix) (with-imported-modules `(,@(source-module-closure `(,@modules + (gnu services herd) (guix build utils)) #:select? module-to-import?) ((guix config) => ,(make-config.scm))) @@ -321,11 +368,15 @@ selected keymap." (gnu installer services) (gnu installer timezone) (gnu installer user) + (gnu installer utils) (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)) ;; Initialize gettext support so that installers can use @@ -335,18 +386,50 @@ selected keymap." ;; Add some binaries used by the installers to PATH. #$set-installer-path + ;; 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)) + (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)) + (_ + ;; The installation failed, exit so that it is restarted + ;; by login. + #f))) (const #f) (lambda (key . args) + (syslog "crashing due to uncaught exception: ~s ~s~%" + key args) (let ((error-file "/tmp/last-installer-error")) (call-with-output-file error-file (lambda (port) @@ -367,4 +450,6 @@ selected keymap." ;; some reason, unicode support is not correctly installed ;; when calling this in 'installer-builder'. (setenv "LANG" "en_US.UTF-8") - (system #$(program-file "installer-real" installer-builder))))) + (execl #$(program-file "installer-real" installer-builder + #:guile guile-3.0-latest) + "installer-real"))))