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

@@ -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 packages)
-  #:use-module (guix records)
+  #: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>
+  #:export (installer-program))
-            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
+(define not-config?
-            lookup-installer-by-name))
+  ;; 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
-;;; Installer record.
+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
+  (define builder
-;; for the system configuration. The goal of the installer is to produce a
+    (with-extensions (list guile-json)
-;; complete <operating-system> record and install it.
+      (with-imported-modules (source-module-closure
+                              '((gnu installer locale)))
+        #~(begin
+            (use-modules (gnu installer locale))
 
-(define-record-type* <installer>
+            ;; The locale files contain non-ASCII characters.
-  installer make-installer
+            #$set-utf8-locale
-  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))
 
-
+            (mkdir #$output)
-;;;
+            (let ((locale-file
-;;; Installers.
+                   (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)
+(define apply-locale
-  "Return the list of installer modules."
+  ;; Install the specified locale.
-  (all-modules (map (lambda (entry)
+  #~(lambda (locale-name)
-                      `(,entry . "gnu/installer"))
+      (false-if-exception
-                    %load-path)
+       (setlocale LC_ALL locale-name))))
-               #:warn warn-about-load-error))
 
-(define %installers
+(define* (compute-locale-step #:key
-  ;; The list of publically-known installers.
+                              locales-name
-  (delay (fold-module-public-variables (lambda (obj result)
+                              iso639-languages-name
-                                         (if (installer? obj)
+                              iso3166-territories-name)
-                                             (cons obj result)
+  "Return a gexp that run the locale-page of INSTALLER, and install the
-                                             result))
+selected locale. The list of locales, languages and territories passed to
-                                       '()
+locale-page are computed in derivations named respectively LOCALES-NAME,
-                                       (installer-top-modules))))
+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)
+  (let* ((supported-locales #~(supported-locales->locales
-  "Return the installer called NAME."
+                               #$(local-file "installer/aux-files/SUPPORTED")))
-  (or (find (lambda (installer)
+         (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
-              (eq? name (installer-name installer)))
+         (iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
-            (force %installers))
+         (iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
-      (leave (G_ "~a: no such installer~%") name)))
+         (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))

gnu/installer/build-installer.scm

@@ -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))

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 i18n)
-  #:use-module (guix ui)
+  #:use-module (srfi srfi-26)
+  #:use-module (newt)
   #:export (newt-installer))
 
-(define (modules)
+(define (init)
-  (cons '(newt)
+  (newt-init)
-        (scheme-modules*
+  (clear-screen)
-         (dirname (search-path %load-path "guix.scm"))
+  (set-screen-size!))
-         "gnu/installer/newt")))
 
-(define init
+(define (exit)
-  #~(begin
+  (newt-finish))
-      (newt-init)
-      (clear-screen)
-      (set-screen-size!)))
 
-(define exit
+(define (exit-error key . args)
-  #~(begin
+  (newt-finish))
-      (newt-finish)))
 
-(define exit-error
+(define* (locale-page #:key
-  #~(lambda (key args)
+                      supported-locales
-      (newt-finish)))
+                      iso639-languages
+                      iso3166-territories)
+  (run-locale-page
+   #:supported-locales supported-locales
+   #:iso639-languages iso639-languages
+   #:iso3166-territories iso3166-territories))
 
-(define locale-page
+(define (timezone-page zonetab)
-  #~(lambda* (#:key
+  (run-timezone-page zonetab))
-              supported-locales
-              iso639-languages
-              iso3166-territories)
-      (run-locale-page
-       #:supported-locales supported-locales
-       #:iso639-languages iso639-languages
-       #:iso3166-territories iso3166-territories)))
 
-(define timezone-page
+(define (welcome-page logo)
-  #~(lambda* (zonetab)
+  (run-welcome-page logo))
-      (run-timezone-page zonetab)))
 
-(define welcome-page
+(define (menu-page steps)
-  #~(run-welcome-page #$(local-file "aux-files/logo.txt")))
+  (run-menu-page steps))
 
-(define menu-page
+(define* (keymap-page #:key models layouts)
-  #~(lambda (steps)
+  (run-keymap-page #:models models
-      (run-menu-page steps)))
+                   #:layouts layouts))
 
-(define keymap-page
+(define (network-page)
-  #~(lambda* (#:key models layouts)
+  (run-network-page))
-      (run-keymap-page #:models models
-                       #:layouts layouts)))
 
-(define network-page
+(define (hostname-page)
-  #~(run-network-page))
+  (run-hostname-page))
 
-(define hostname-page
+(define (user-page)
-  #~(run-hostname-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)

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))

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.

gnu/system/install.scm

@@ -28,8 +28,7 @@ (define-module (gnu system install)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module ((guix store) #:select (%store-prefix))
-  #:use-module (gnu installer newt)
+  #:use-module (gnu installer)
-  #:use-module (gnu installer build-installer)
   #:use-module (gnu services dbus)
   #:use-module (gnu services networking)
   #:use-module (gnu services shepherd)
@@ -233,8 +232,7 @@ (define bare-bones-os
           (service kmscon-service-type
                    (kmscon-configuration
                     (virtual-terminal "tty1")
-                    (login-program (installer-program-launcher
+                    (login-program (installer-program))))
-                                    newt-installer))))
 
           (login-service (login-configuration
                           (motd motd)))

guix/self.scm

@@ -604,11 +604,7 @@ (define *system-modules*
     (scheme-node "guix-system"
                  `((gnu system)
                    (gnu services)
-                   ,@(filter-map
+                   ,@(scheme-modules* source "gnu/system")
-                      (match-lambda
-                        (('gnu 'system 'install) #f)
-                        (name name))
-                      (scheme-modules* source "gnu/system"))
                    ,@(scheme-modules* source "gnu/services"))
                  (list *core-package-modules* *package-modules*
                        *extra-modules* *core-modules*)
@@ -616,7 +612,9 @@ (define *system-modules*
                  #: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)))

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