;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
;;;
;;; This file is part of GNU Guix.
;;;
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
+ #:use-module (guix discovery)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix modules)
#: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)
#: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 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)
+ (('gnu 'installer _ ...) #t)
+ (('gnu 'build _ ...) #t)
+ (('guix 'build _ ...) #t)
+ (_ #f)))
+
(define not-config?
;; Select (guix …) and (gnu …) modules, except (guix config).
(match-lambda
(('guix 'config) #f)
- (('guix rest ...) #t)
- (('gnu rest ...) #t)
- (rest #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
(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))
(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
(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"))
(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)
"/share/X11/xkb/rules/base.xml")))
(lambda (models layouts)
((installer-keymap-page current-installer)
- layouts)))))
- (#$apply-keymap result))))
+ layouts '#$context)))))
+ (#$apply-keymap result)
+ result)))
(define (installer-steps)
(let ((locale-step (compute-locale-step
#: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
- ;; Welcome the user and ask him to choose between manual installation
- ;; and graphical install.
- (installer-step
- (id 'welcome)
- (compute (lambda _
- ((installer-welcome-page current-installer)
- #$(local-file "installer/aux-files/logo.txt")))))
-
- ;; 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.
+ ;; 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 'locale)
(description (G_ "Locale"))
(#$locale-step current-installer)))
(configuration-formatter locale->configuration))
+ ;; Welcome the user and ask them to choose between manual
+ ;; installation and graphical install.
+ (installer-step
+ (id 'welcome)
+ (compute (lambda _
+ ((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)
;; 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))
;; Ask the user to input a hostname for the system.
(installer-step
((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-user-page current-installer)))))
+ ((installer-services-page current-installer))))
+ (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
(lambda (result prev-steps)
((installer-final-page current-installer)
- result prev-steps)))))))
+ result prev-steps))))))))
(define (installer-program)
"Return a file-like object that runs the given INSTALLER."
(define set-installer-path
;; Add the specified binary to PATH for later use by the installer.
#~(let* ((inputs
- '#$(append (list bash connman shadow)
- (map canonical-package (list coreutils)))))
+ '#$(list bash ;start subshells
+ connman ;call connmanctl
+ cryptsetup
+ dosfstools ;mkfs.fat
+ e2fsprogs ;mkfs.ext4
+ btrfs-progs
+ jfsutils ;jfs_mkfs
+ 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)))))
(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 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
;; 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)
- ((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)))
+ (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)
+ (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)))))))
;; 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)
+ "installer-real"))))