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.
This commit is contained in:
Mathieu Othacehe
Ludovic Courtès
parent
113bdf6ae1
commit
a49d633c0c
|
|
@ -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
|
||||
#:export (installer-program))
|
||||
|
||||
%installers
|
||||
lookup-installer-by-name))
|
||||
(define not-config?
|
||||
;; Select (guix …) and (gnu …) modules, except (guix config).
|
||||
(match-lambda
|
||||
(('guix 'config) #f)
|
||||
(('guix rest ...) #t)
|
||||
(('gnu rest ...) #t)
|
||||
(rest #f)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Installer record.
|
||||
;;;
|
||||
(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")))
|
||||
|
||||
;; 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 builder
|
||||
(with-extensions (list guile-json)
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu installer locale)))
|
||||
#~(begin
|
||||
(use-modules (gnu installer locale))
|
||||
|
||||
(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))
|
||||
;; The locale files contain non-ASCII characters.
|
||||
#$set-utf8-locale
|
||||
|
||||
|
||||
;;;
|
||||
;;; Installers.
|
||||
;;;
|
||||
(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 (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 apply-locale
|
||||
;; Install the specified locale.
|
||||
#~(lambda (locale-name)
|
||||
(false-if-exception
|
||||
(setlocale LC_ALL locale-name))))
|
||||
|
||||
(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* (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")))
|
||||
|
||||
(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)))
|
||||
(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))))))
|
||||
|
||||
(program-file "installer" installer-builder))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,75 @@
|
|||
;;; 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 record)
|
||||
#:use-module (guix records)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (<installer>
|
||||
installer
|
||||
make-installer
|
||||
installer?
|
||||
installer-name
|
||||
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))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Installer record.
|
||||
;;;
|
||||
|
||||
;; 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)
|
||||
;; 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))
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue