a79617468e
Source /etc/environment just before starting the installer. The login program is supposed to load the environment variables of this file through PAM, but as we replace it by the installer, they are no longer available. This is mostly useful for the LANG environment variable. * gnu/installer/build-installer.scm (installer-program-launcher): New exported procedure. * gnu/system/install.scm (%installation-services): Restore most of the origin code. kmscon is only started on TTY1, and the graphical installer is the login-program.
323 lines
13 KiB
Scheme
323 lines
13 KiB
Scheme
;;; 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 build-installer)
|
|
#: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 (gnu installer)
|
|
#:use-module (gnu packages admin)
|
|
#:use-module (gnu packages base)
|
|
#:use-module (gnu packages bash)
|
|
#:use-module (gnu packages connman)
|
|
#:use-module (gnu packages guile)
|
|
#: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 (ice-9 match)
|
|
#:use-module (srfi srfi-1)
|
|
#:export (installer-program
|
|
installer-program-launcher))
|
|
|
|
(define not-config?
|
|
;; Select (guix …) and (gnu …) modules, except (guix config).
|
|
(match-lambda
|
|
(('guix 'config) #f)
|
|
(('guix rest ...) #t)
|
|
(('gnu rest ...) #t)
|
|
(rest #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
|
|
version of this file."
|
|
(define set-utf8-locale
|
|
#~(begin
|
|
(setenv "LOCPATH"
|
|
#$(file-append glibc-utf8-locales "/lib/locale/"
|
|
(version-major+minor
|
|
(package-version glibc-utf8-locales))))
|
|
(setlocale LC_ALL "en_US.utf8")))
|
|
|
|
(define builder
|
|
(with-extensions (list guile-json)
|
|
(with-imported-modules (source-module-closure
|
|
'((gnu installer locale)))
|
|
#~(begin
|
|
(use-modules (gnu installer locale))
|
|
|
|
;; The locale files contain non-ASCII characters.
|
|
#$set-utf8-locale
|
|
|
|
(mkdir #$output)
|
|
(let ((locale-file
|
|
(string-append #$output "/" #$name ".scm"))
|
|
(locale-compiled-file
|
|
(string-append #$output "/" #$name ".go")))
|
|
(call-with-output-file locale-file
|
|
(lambda (port)
|
|
(write #$locale-builder port)))
|
|
(compile-file locale-file
|
|
#:output-file locale-compiled-file))))))
|
|
(computed-file name builder))
|
|
|
|
(define apply-locale
|
|
;; Install the specified locale.
|
|
#~(lambda (locale-name)
|
|
(false-if-exception
|
|
(setlocale LC_ALL locale-name))))
|
|
|
|
(define* (compute-locale-step installer
|
|
#:key
|
|
locales-name
|
|
iso639-languages-name
|
|
iso3166-territories-name)
|
|
"Return a gexp that run the locale-page of INSTALLER, and install the
|
|
selected locale. The list of locales, languages and territories passed to
|
|
locale-page are computed in derivations named respectively LOCALES-NAME,
|
|
ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
|
|
so that when the installer is run, all the lengthy operations have already
|
|
been performed at build time."
|
|
(define (compiled-file-loader file name)
|
|
#~(load-compiled
|
|
(string-append #$file "/" #$name ".go")))
|
|
|
|
(let* ((supported-locales #~(supported-locales->locales
|
|
#$(local-file "aux-files/SUPPORTED")))
|
|
(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"))
|
|
(iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
|
|
(locales-file (build-compiled-file
|
|
locales-name
|
|
#~`(quote ,#$supported-locales)))
|
|
(iso639-file (build-compiled-file
|
|
iso639-languages-name
|
|
#~`(quote ,(iso639->iso639-languages
|
|
#$supported-locales
|
|
#$iso639-3 #$iso639-5))))
|
|
(iso3166-file (build-compiled-file
|
|
iso3166-territories-name
|
|
#~`(quote ,(iso3166->iso3166-territories #$iso3166))))
|
|
(locales-loader (compiled-file-loader locales-file
|
|
locales-name))
|
|
(iso639-loader (compiled-file-loader iso639-file
|
|
iso639-languages-name))
|
|
(iso3166-loader (compiled-file-loader iso3166-file
|
|
iso3166-territories-name)))
|
|
#~(let ((result
|
|
(#$(installer-locale-page installer)
|
|
#:supported-locales #$locales-loader
|
|
#:iso639-languages #$iso639-loader
|
|
#:iso3166-territories #$iso3166-loader)))
|
|
(#$apply-locale result))))
|
|
|
|
(define apply-keymap
|
|
;; Apply the specified keymap.
|
|
#~(match-lambda
|
|
((model layout variant)
|
|
(kmscon-update-keymap model layout variant))))
|
|
|
|
(define* (compute-keymap-step installer)
|
|
"Return a gexp that runs the keymap-page of INSTALLER and install the
|
|
selected keymap."
|
|
#~(let ((result
|
|
(call-with-values
|
|
(lambda ()
|
|
(xkb-rules->models+layouts
|
|
(string-append #$xkeyboard-config
|
|
"/share/X11/xkb/rules/base.xml")))
|
|
(lambda (models layouts)
|
|
(#$(installer-keymap-page installer)
|
|
#:models models
|
|
#:layouts layouts)))))
|
|
(#$apply-keymap result)))
|
|
|
|
(define (installer-steps installer)
|
|
(let ((locale-step (compute-locale-step
|
|
installer
|
|
#:locales-name "locales"
|
|
#:iso639-languages-name "iso639-languages"
|
|
#:iso3166-territories-name "iso3166-territories"))
|
|
(keymap-step (compute-keymap-step installer))
|
|
(timezone-data #~(string-append #$tzdata
|
|
"/share/zoneinfo/zone.tab")))
|
|
#~(list
|
|
;; Welcome the user and ask him to choose between manual installation
|
|
;; and graphical install.
|
|
(installer-step
|
|
(id 'welcome)
|
|
(compute (lambda _
|
|
#$(installer-welcome-page installer))))
|
|
|
|
;; 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 selection"))
|
|
(compute (lambda _
|
|
#$locale-step)))
|
|
|
|
;; Ask the user to select a timezone under glibc format.
|
|
(installer-step
|
|
(id 'timezone)
|
|
(description (G_ "Timezone selection"))
|
|
(compute (lambda _
|
|
(#$(installer-timezone-page installer)
|
|
#$timezone-data))))
|
|
|
|
;; 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.
|
|
;;
|
|
;; So ask for a keyboard model, layout and variant to update the
|
|
;; current kmscon keymap.
|
|
(installer-step
|
|
(id 'keymap)
|
|
(description (G_ "Keyboard mapping selection"))
|
|
(compute (lambda _
|
|
#$keymap-step)))
|
|
|
|
;; Ask the user to input a hostname for the system.
|
|
(installer-step
|
|
(id 'hostname)
|
|
(description (G_ "Hostname selection"))
|
|
(compute (lambda _
|
|
#$(installer-hostname-page installer))))
|
|
|
|
;; Provide an interface above connmanctl, so that the user can select
|
|
;; a network susceptible to acces Internet.
|
|
(installer-step
|
|
(id 'network)
|
|
(description (G_ "Network selection"))
|
|
(compute (lambda _
|
|
#$(installer-network-page installer))))
|
|
|
|
;; Prompt for users (name, group and home directory).
|
|
(installer-step
|
|
(id 'hostname)
|
|
(description (G_ "User selection"))
|
|
(compute (lambda _
|
|
#$(installer-user-page installer)))))))
|
|
|
|
(define (installer-program installer)
|
|
"Return a file-like object that runs the given INSTALLER."
|
|
(define init-gettext
|
|
;; Initialize gettext support, so that installer messages can be
|
|
;; translated.
|
|
#~(begin
|
|
(bindtextdomain "guix" (string-append #$guix "/share/locale"))
|
|
(textdomain "guix")))
|
|
|
|
(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)))))
|
|
(with-output-to-port (%make-void-port "w")
|
|
(lambda ()
|
|
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
|
|
|
|
(define installer-builder
|
|
(with-extensions (list guile-gcrypt guile-newt guile-json)
|
|
(with-imported-modules `(,@(source-module-closure
|
|
`(,@(installer-modules installer)
|
|
(guix build utils))
|
|
#:select? not-config?)
|
|
((guix config) => ,(make-config.scm)))
|
|
#~(begin
|
|
(use-modules (gnu installer keymap)
|
|
(gnu installer steps)
|
|
(gnu installer locale)
|
|
#$@(installer-modules installer)
|
|
(guix i18n)
|
|
(guix build utils)
|
|
(ice-9 match))
|
|
|
|
;; Initialize gettext support so that installers can use
|
|
;; (guix i18n) module.
|
|
#$init-gettext
|
|
|
|
;; Add some binaries used by the installers to PATH.
|
|
#$set-installer-path
|
|
|
|
#$(installer-init installer)
|
|
|
|
(catch #t
|
|
(lambda ()
|
|
(run-installer-steps
|
|
#:rewind-strategy 'menu
|
|
#:menu-proc #$(installer-menu-page installer)
|
|
#:steps #$(installer-steps installer)))
|
|
(const #f)
|
|
(lambda (key . args)
|
|
(#$(installer-exit-error 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 installer)))))
|
|
|
|
(program-file "installer" installer-builder))
|
|
|
|
;; We want the installer to honor the LANG environment variable, so that the
|
|
;; locale is correctly installed when the installer is launched, and the
|
|
;; welcome page is possibly translated. The /etc/environment file (containing
|
|
;; LANG) is supposed to be loaded using PAM by the login program. As the
|
|
;; installer replaces the login program, read this file and set all the
|
|
;; variables it contains before starting the installer. This is a dirty hack,
|
|
;; we might want to find a better way to do it in the future.
|
|
(define (installer-program-launcher installer)
|
|
"Return a file-like object that set the variables in /etc/environment and
|
|
run the given INSTALLER."
|
|
(define load-environment
|
|
#~(call-with-input-file "/etc/environment"
|
|
(lambda (port)
|
|
(let ((lines (read-lines port)))
|
|
(map (lambda (line)
|
|
(match (string-split line #\=)
|
|
((name value)
|
|
(setenv name value))))
|
|
lines)))))
|
|
|
|
(define wrapper
|
|
(with-imported-modules '((gnu installer utils))
|
|
#~(begin
|
|
(use-modules (gnu installer utils)
|
|
(ice-9 match))
|
|
|
|
#$load-environment
|
|
(system #$(installer-program installer)))))
|
|
|
|
(program-file "installer-launcher" wrapper))
|