diff options
| -rw-r--r-- | gnu/installer.scm | 363 | ||||
| -rw-r--r-- | gnu/installer/build-installer.scm | 322 | ||||
| -rw-r--r-- | gnu/installer/newt.scm | 94 | ||||
| -rw-r--r-- | gnu/installer/record.scm | 75 | ||||
| -rw-r--r-- | gnu/local.mk | 7 | ||||
| -rw-r--r-- | gnu/system/install.scm | 6 | ||||
| -rw-r--r-- | guix/self.scm | 10 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 2 |
8 files changed, 409 insertions, 470 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index f3323ea3bc..9e773ee8f0 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 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)) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index 23b737ddf0..db57c732d1 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/record.scm b/gnu/installer/record.scm new file mode 100644 index 0000000000..9c10c65758 --- /dev/null +++ b/gnu/installer/record.scm @@ -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)) diff --git a/gnu/local.mk b/gnu/local.mk index 665721bec1..b0ec16de34 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 aef083506c..880a8be32d 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 2698596387..4df4f6506e 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 585ceeb5c2..1378b33e0e 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 |