diff options
author | Mathieu Othacehe <m.othacehe@gmail.com> | 2018-11-24 12:25:03 +0900 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-17 14:04:21 +0100 |
commit | a49d633c0c65975263270f5ac0050482ca6a5513 (patch) | |
tree | 362e0df559e06cacb31b04fd384344ef789ef0dc /gnu/installer/build-installer.scm | |
parent | 113bdf6ae1819022d8c0d640b78a37c7d6b52723 (diff) | |
download | guix-patches-a49d633c0c65975263270f5ac0050482ca6a5513.tar guix-patches-a49d633c0c65975263270f5ac0050482ca6a5513.tar.gz |
installer: Move everything to the build side.
* gnu/installer.scm: Rename to ...
* gnu/installer/record.scm: ... this.
* gnu/installer/build-installer.scm: Move everything to the build side and
rename to gnu/installer.scm.
* gnu/installer/newt.scm: Remove all the gexps and add depencies to newt
modules as this code will only be used on the build side by now.
* gnu/local.mk (GNU_SYSTEM_MODULES): Adapt it,
(dist_installer_DATA): New rule to install installer's aux-files.
* gnu/system/install.scm (%installation-services): Use only
'installer-program' from (gnu installer). The installer is now choosen on the
build side.
* guix/self.scm (*system-modules*): Restore previous behaviour and add all
installer files to #:extra-files field of the scheme-node.
* po/guix/POTFILES.in: Adapt it.
Diffstat (limited to 'gnu/installer/build-installer.scm')
-rw-r--r-- | gnu/installer/build-installer.scm | 322 |
1 files changed, 0 insertions, 322 deletions
diff --git a/gnu/installer/build-installer.scm b/gnu/installer/build-installer.scm deleted file mode 100644 index c7f439b35f..0000000000 --- a/gnu/installer/build-installer.scm +++ /dev/null @@ -1,322 +0,0 @@ -;;; 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)) |