[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
13/68: installer: Move everything to the build side.
|
From: |
guix-commits |
|
Subject: |
13/68: installer: Move everything to the build side. |
|
Date: |
Thu, 17 Jan 2019 08:05:10 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit a49d633c0c65975263270f5ac0050482ca6a5513
Author: Mathieu Othacehe <address@hidden>
Date: Sat Nov 24 12:25:03 2018 +0900
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.
---
gnu/installer.scm | 363 +++++++++++++++++++++-------
gnu/installer/build-installer.scm | 322 ------------------------
gnu/installer/newt.scm | 94 ++++---
gnu/{installer.scm => installer/record.scm} | 40 +--
gnu/local.mk | 7 +-
gnu/system/install.scm | 6 +-
guix/self.scm | 10 +-
po/guix/POTFILES.in | 2 +-
8 files changed, 336 insertions(+), 508 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index f3323ea..9e773ee 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -17,95 +17,282 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer)
- #:use-module (guix discovery)
- #:use-module (guix records)
+ #: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 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>
- installer
- make-installer
- installer?
- installer-name
- installer-modules
- installer-init
- installer-exit
- installer-exit-error
- installer-keymap-page
- installer-locale-page
- installer-menu-page
- installer-network-page
- installer-timezone-page
- installer-hostname-page
- installer-user-page
- installer-welcome-page
-
- %installers
- lookup-installer-by-name))
-
-
-;;;
-;;; Installer record.
-;;;
+ #:export (installer-program))
-;; The <installer> record contains pages that will be run to prompt the user
-;; for the system configuration. The goal of the installer is to produce a
-;; complete <operating-system> record and install it.
-
-(define-record-type* <installer>
- installer make-installer
- installer?
- ;; symbol
- (name installer-name)
- ;; list of installer modules
- (modules installer-modules)
- ;; procedure: void -> void
- (init installer-init)
- ;; procedure: void -> void
- (exit installer-exit)
- ;; procedure (key arguments) -> void
- (exit-error installer-exit-error)
- ;; procedure (#:key models layouts) -> (list model layout variant)
- (keymap-page installer-keymap-page)
- ;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
- ;; -> glibc-locale
- (locale-page installer-locale-page)
- ;; procedure: (steps) -> step-id
- (menu-page installer-menu-page)
- ;; procedure void -> void
- (network-page installer-network-page)
- ;; procedure (zonetab) -> posix-timezone
- (timezone-page installer-timezone-page)
- ;; procedure void -> void
- (hostname-page installer-hostname-page)
- ;; procedure void -> void
- (user-page installer-user-page)
- ;; procedure (logo) -> void
- (welcome-page installer-welcome-page))
-
-
-;;;
-;;; Installers.
-;;;
+(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 #: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 "installer/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)))
+ #~(lambda (current-installer)
+ (let ((result
+ ((installer-locale-page current-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)
+ "Return a gexp that runs the keymap-page of INSTALLER and install the
+selected keymap."
+ #~(lambda (current-installer)
+ (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 current-installer)
+ #:models models
+ #:layouts layouts)))))
+ (#$apply-keymap 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)
+ (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.
+ (installer-step
+ (id 'locale)
+ (description (G_ "Locale selection"))
+ (compute (lambda _
+ (#$locale-step current-installer))))
+
+ ;; Ask the user to select a timezone under glibc format.
+ (installer-step
+ (id 'timezone)
+ (description (G_ "Timezone selection"))
+ (compute (lambda _
+ ((installer-timezone-page current-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 current-installer))))
+
+ ;; Ask the user to input a hostname for the system.
+ (installer-step
+ (id 'hostname)
+ (description (G_ "Hostname selection"))
+ (compute (lambda _
+ ((installer-hostname-page current-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 current-installer)))))
+
+ ;; Prompt for users (name, group and home directory).
+ (installer-step
+ (id 'hostname)
+ (description (G_ "User selection"))
+ (compute (lambda _
+ ((installer-user-page current-installer)))))))))
+
+(define (installer-program)
+ "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 steps (installer-steps))
+
+ (define installer-builder
+ (with-extensions (list guile-gcrypt guile-newt guile-json)
+ (with-imported-modules `(,@(source-module-closure
+ '((gnu installer newt)
+ (guix build utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu installer record)
+ (gnu installer keymap)
+ (gnu installer steps)
+ (gnu installer locale)
+ (gnu installer newt)
+ (guix i18n)
+ (guix build utils)
+ (ice-9 match))
+
+ ;; Set the default locale to install unicode support.
+ (setlocale LC_ALL "en_US.utf8")
+
+ ;; 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
+
+ (let ((current-installer newt-installer))
+ ((installer-init current-installer))
+
+ (catch #t
+ (lambda ()
+ (run-installer-steps
+ #:rewind-strategy 'menu
+ #:menu-proc (installer-menu-page current-installer)
+ #:steps (#$steps current-installer)))
+ (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)))
+ (primitive-exit 1))))
+ ((installer-exit current-installer))))))
-(define (installer-top-modules)
- "Return the list of installer modules."
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/installer"))
- %load-path)
- #:warn warn-about-load-error))
-
-(define %installers
- ;; The list of publically-known installers.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (installer? obj)
- (cons obj result)
- result))
- '()
- (installer-top-modules))))
-
-(define (lookup-installer-by-name name)
- "Return the installer called NAME."
- (or (find (lambda (installer)
- (eq? name (installer-name installer)))
- (force %installers))
- (leave (G_ "~a: no such installer~%") name)))
+ (program-file "installer" installer-builder))
diff --git a/gnu/installer/build-installer.scm
b/gnu/installer/build-installer.scm
deleted file mode 100644
index c7f439b..0000000
--- a/gnu/installer/build-installer.scm
+++ /dev/null
@@ -1,322 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <address@hidden>
-;;;
-;;; 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))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 23b737d..db57c73 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -17,71 +17,69 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer newt)
- #:use-module (gnu installer)
+ #:use-module (gnu installer record)
+ #:use-module (gnu installer newt ethernet)
+ #:use-module (gnu installer newt hostname)
+ #:use-module (gnu installer newt keymap)
+ #:use-module (gnu installer newt locale)
+ #:use-module (gnu installer newt menu)
+ #:use-module (gnu installer newt network)
+ #:use-module (gnu installer newt timezone)
+ #:use-module (gnu installer newt user)
+ #:use-module (gnu installer newt utils)
+ #:use-module (gnu installer newt welcome)
+ #:use-module (gnu installer newt wifi)
#:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix ui)
+ #:use-module (guix i18n)
+ #:use-module (srfi srfi-26)
+ #:use-module (newt)
#:export (newt-installer))
-(define (modules)
- (cons '(newt)
- (scheme-modules*
- (dirname (search-path %load-path "guix.scm"))
- "gnu/installer/newt")))
+(define (init)
+ (newt-init)
+ (clear-screen)
+ (set-screen-size!))
-(define init
- #~(begin
- (newt-init)
- (clear-screen)
- (set-screen-size!)))
+(define (exit)
+ (newt-finish))
-(define exit
- #~(begin
- (newt-finish)))
+(define (exit-error key . args)
+ (newt-finish))
-(define exit-error
- #~(lambda (key args)
- (newt-finish)))
+(define* (locale-page #:key
+ supported-locales
+ iso639-languages
+ iso3166-territories)
+ (run-locale-page
+ #:supported-locales supported-locales
+ #:iso639-languages iso639-languages
+ #:iso3166-territories iso3166-territories))
-(define locale-page
- #~(lambda* (#:key
- supported-locales
- iso639-languages
- iso3166-territories)
- (run-locale-page
- #:supported-locales supported-locales
- #:iso639-languages iso639-languages
- #:iso3166-territories iso3166-territories)))
+(define (timezone-page zonetab)
+ (run-timezone-page zonetab))
-(define timezone-page
- #~(lambda* (zonetab)
- (run-timezone-page zonetab)))
+(define (welcome-page logo)
+ (run-welcome-page logo))
-(define welcome-page
- #~(run-welcome-page #$(local-file "aux-files/logo.txt")))
+(define (menu-page steps)
+ (run-menu-page steps))
-(define menu-page
- #~(lambda (steps)
- (run-menu-page steps)))
+(define* (keymap-page #:key models layouts)
+ (run-keymap-page #:models models
+ #:layouts layouts))
-(define keymap-page
- #~(lambda* (#:key models layouts)
- (run-keymap-page #:models models
- #:layouts layouts)))
+(define (network-page)
+ (run-network-page))
-(define network-page
- #~(run-network-page))
+(define (hostname-page)
+ (run-hostname-page))
-(define hostname-page
- #~(run-hostname-page))
-
-(define user-page
- #~(run-user-page))
+(define (user-page)
+ (run-user-page))
(define newt-installer
(installer
(name 'newt)
- (modules (modules))
(init init)
(exit exit)
(exit-error exit-error)
diff --git a/gnu/installer.scm b/gnu/installer/record.scm
similarity index 67%
copy from gnu/installer.scm
copy to gnu/installer/record.scm
index f3323ea..9c10c65 100644
--- a/gnu/installer.scm
+++ b/gnu/installer/record.scm
@@ -16,17 +16,14 @@
;;; 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)
- #:use-module (guix discovery)
+(define-module (gnu installer record)
#:use-module (guix records)
- #:use-module (guix ui)
#:use-module (srfi srfi-1)
#:export (<installer>
installer
make-installer
installer?
installer-name
- installer-modules
installer-init
installer-exit
installer-exit-error
@@ -37,10 +34,7 @@
installer-timezone-page
installer-hostname-page
installer-user-page
- installer-welcome-page
-
- %installers
- lookup-installer-by-name))
+ installer-welcome-page))
;;;
@@ -56,8 +50,6 @@
installer?
;; symbol
(name installer-name)
- ;; list of installer modules
- (modules installer-modules)
;; procedure: void -> void
(init installer-init)
;; procedure: void -> void
@@ -81,31 +73,3 @@
(user-page installer-user-page)
;; procedure (logo) -> void
(welcome-page installer-welcome-page))
-
-
-;;;
-;;; Installers.
-;;;
-
-(define (installer-top-modules)
- "Return the list of installer modules."
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/installer"))
- %load-path)
- #:warn warn-about-load-error))
-
-(define %installers
- ;; The list of publically-known installers.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (installer? obj)
- (cons obj result)
- result))
- '()
- (installer-top-modules))))
-
-(define (lookup-installer-by-name name)
- "Return the installer called NAME."
- (or (find (lambda (installer)
- (eq? name (installer-name installer)))
- (force %installers))
- (leave (G_ "~a: no such installer~%") name)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 665721b..b0ec16d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -567,7 +567,7 @@ if ENABLE_INSTALLER
GNU_SYSTEM_MODULES += \
%D%/installer.scm \
- %D%/installer/build-installer.scm \
+ %D%/installer/record.scm \
%D%/installer/connman.scm \
%D%/installer/keymap.scm \
%D%/installer/locale.scm \
@@ -588,6 +588,11 @@ GNU_SYSTEM_MODULES += \
%D%/installer/newt/welcome.scm \
%D%/installer/newt/wifi.scm
+installerdir = $(guilemoduledir)/%D%/installer
+dist_installer_DATA = \
+ %D%/installer/aux-files/logo.txt \
+ %D%/installer/aux-files/SUPPORTED
+
endif ENABLE_INSTALLER
# Modules that do not need to be compiled.
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index aef0835..880a8be 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -28,8 +28,7 @@
#:use-module (guix store)
#:use-module (guix monads)
#:use-module ((guix store) #:select (%store-prefix))
- #:use-module (gnu installer newt)
- #:use-module (gnu installer build-installer)
+ #:use-module (gnu installer)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services shepherd)
@@ -233,8 +232,7 @@ You have been warned. Thanks for being so brave.\x1b[0m
(service kmscon-service-type
(kmscon-configuration
(virtual-terminal "tty1")
- (login-program (installer-program-launcher
- newt-installer))))
+ (login-program (installer-program))))
(login-service (login-configuration
(motd motd)))
diff --git a/guix/self.scm b/guix/self.scm
index 2698596..4df4f65 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -604,11 +604,7 @@ Info manual."
(scheme-node "guix-system"
`((gnu system)
(gnu services)
- ,@(filter-map
- (match-lambda
- (('gnu 'system 'install) #f)
- (name name))
- (scheme-modules* source "gnu/system"))
+ ,@(scheme-modules* source "gnu/system")
,@(scheme-modules* source "gnu/services"))
(list *core-package-modules* *package-modules*
*extra-modules* *core-modules*)
@@ -616,7 +612,9 @@ Info manual."
#:extra-files
(append (file-imports source "gnu/system/examples"
(const #t))
-
+ ;; All the installer code is on the build-side.
+ (file-imports source "gnu/installer/"
+ (const #t))
;; Build-side code that we don't build. Some of
;; these depend on guile-rsvg, the Shepherd, etc.
(file-imports source "gnu/build" (const #t)))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 585ceeb..1378b33 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -9,7 +9,7 @@ gnu/system/mapped-devices.scm
gnu/system/shadow.scm
guix/import/opam.scm
gnu/installer.scm
-gnu/installer/build-installer.scm
+gnu/installer/record.scm
gnu/installer/connman.scm
gnu/installer/keymap.scm
gnu/installer/locale.scm
- 50/68: installer: partition: Fix swaping and use syscalls., (continued)
- 50/68: installer: partition: Fix swaping and use syscalls., guix-commits, 2019/01/17
- 51/68: installer: partition: Fix typo., guix-commits, 2019/01/17
- 55/68: installer: parted: Use read-luks-partition-uuid instead of find-partition-by-luks-uuid., guix-commits, 2019/01/17
- 30/68: installer: Fix comments., guix-commits, 2019/01/17
- 59/68: installer: Rename "Ok" buttons to "OK"., guix-commits, 2019/01/17
- 47/68: installer: Display an eventual backtrace in a page., guix-commits, 2019/01/17
- 26/68: installer: Add hostname., guix-commits, 2019/01/17
- 10/68: guix: self: Do not install (gnu system install)., guix-commits, 2019/01/17
- 25/68: installer: Add services page., guix-commits, 2019/01/17
- 11/68: gnu: installer: Launch the installer as kmscon login-program., guix-commits, 2019/01/17
- 13/68: installer: Move everything to the build side.,
guix-commits <=
- 15/68: tests: Rename %test-encrypted-os to %test-encrypted-root-os., guix-commits, 2019/01/17
- 17/68: services: herd: Allow to pass arguments to start-service., guix-commits, 2019/01/17
- 19/68: gnu: Add guile-parted., guix-commits, 2019/01/17
- 16/68: build: syscalls: Add device-in-use?., guix-commits, 2019/01/17
- 18/68: gnu: guile-newt: Update to revision 4., guix-commits, 2019/01/17
- 62/68: installer: keymap: Put English layout and international variant ahead., guix-commits, 2019/01/17
- 12/68: installer: Rewrite welcome page., guix-commits, 2019/01/17
- 64/68: syscalls: 'device-in-use?' does not create a port., guix-commits, 2019/01/17
- 14/68: installer: Fix locale installation., guix-commits, 2019/01/17
- 68/68: installer: Fix manual partitioning., guix-commits, 2019/01/17