;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; 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.
;;;
#: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)
(('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
its result in the scheme file NAME. The derivation will also build a compiled
(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))
(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")
+ ;; language that corresponds to LOCALE. Make sure that nothing is
+ ;; printed on the console.
+ (parameterize ((shepherd-message-port
+ (%make-void-port "w")))
(lambda ()
(stop-service 'term-tty2)
(start-service 'term-tty2 (list locale)))))))
(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)))))
+ layouts '#$context)))))
(#$apply-keymap result)
result)))
#: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
;; 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)
(description (G_ "Services"))
(compute (lambda _
((installer-services-page current-installer))))
- (configuration-formatter system-services->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
((installer-final-page current-installer)
result prev-steps))))))))
+(define guile-newt
+ ;; Guile-Newt with 'form-watch-fd'.
+ ;; TODO: Remove once a new release is out.
+ (let ((commit "c3cdeb0b53ac71aedabee669f57d44563c662446")
+ (revision "2"))
+ (package
+ (inherit (@ (gnu packages guile-xyz) guile-newt))
+ (name "guile-newt")
+ (version (git-version "0.0.1" revision commit))
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://gitlab.com/mothacehe/guile-newt")
+ (commit commit)))
+ (file-name (git-file-name name version))
+ (sha256
+ (base32
+ "1gksd1lzgjjh1p9vczghg8jw995d22hm34kbsiv8rcryirv2xy09")))))))
+
(define (installer-program)
"Return a file-like object that runs the given INSTALLER."
(define init-gettext
cryptsetup
dosfstools ;mkfs.fat
e2fsprogs ;mkfs.ext4
- btrfs-progs
+ btrfs-progs ;mkfs.btrfs
+ jfsutils ;jfs_mkfs
kbd ;chvt
guix ;guix system init call
util-linux ;mkwap
;; 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)
;; We did it! Let's reboot!
(sync)
(stop-service 'root))
- (_ ;installation failed
- ;; TODO: Honor the result of 'run-install-failed-page'.
+ (_
+ ;; 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)
HCoop / jackhill / guix / guix.git / blobdiff