10/67: gnu: installer: Launch the installer as kmscon login-program.

[guix-commits]

civodul pushed a commit to branch wip-newt-installer
in repository guix.

commit 0ab9cf9c20875553602c12ed64602543b6384419
Author: Mathieu Othacehe <address@hidden>
Date:   Fri Nov 23 23:18:59 2018 +0900

    gnu: installer: Launch the installer as kmscon login-program.
    
    Source /etc/environment just before starting the installer. The login 
program
    is supposed to load the environment variables of this file through PAM, but 
as
    we replace it by the installer, they are no longer available. This is mostly
    useful for the LANG environment variable.
    
    * gnu/installer/build-installer.scm (installer-program-launcher): New 
exported
    procedure.
    * gnu/system/install.scm (%installation-services): Restore most of the 
origin
    code. kmscon is only started on TTY1, and the graphical installer is the
    login-program.
---
 gnu/installer/build-installer.scm |  34 +++++-
 gnu/system/install.scm            | 245 ++++++++++++++++++++------------------
 2 files changed, 160 insertions(+), 119 deletions(-)

diff --git a/gnu/installer/build-installer.scm 
b/gnu/installer/build-installer.scm
index 1a084bc..c7f439b 100644
--- a/gnu/installer/build-installer.scm
+++ b/gnu/installer/build-installer.scm
@@ -37,7 +37,8 @@
   #:use-module (gnu packages xorg)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:export (installer-program))
+  #:export (installer-program
+            installer-program-launcher))
 
 (define not-config?
   ;; Select (guix …) and (gnu …) modules, except (guix config).
@@ -288,3 +289,34 @@ selected keymap."
             #$(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/system/install.scm b/gnu/system/install.scm
index 05f3795..aef0835 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -209,114 +209,128 @@ the user's target storage device rather than on the RAM 
disk."
                     (persistent? #f)
                     (max-database-size (* 5 (expt 2 20)))))) ;5 MiB
 
-(define (normal-tty tty)
-  (service kmscon-service-type
-           (kmscon-configuration
-            (virtual-terminal tty)
-            (auto-login "root"))))
-
-(define bare-bones-os
-  (load "examples/bare-bones.tmpl"))
-
 (define %installation-services
   ;; List of services of the installation system.
-  (list (login-service (login-configuration
-                        ;; The motd is overlapped by the graphical installer,
-                        ;; so make sure it is not printed.
-                        (motd #f)))
-
-        ;; This will be the active virtual terminal at boot.  The graphical
-        ;; installer is launched as the 'shell' program of the root
-        ;; user-account.  Thanks to auto-login, it will be started
-        ;; automatically.  Another option would have been to set the graphical
-        ;; installer as a login program.  However, it is preferable to wait
-        ;; for the login phase to be over, so that the environnment variables
-        ;; of /etc/environment like LANG are loaded by PAM.
-        (normal-tty "tty1")
-
-        ;; Documentation.
-        (service kmscon-service-type
-                 (kmscon-configuration
-                  (virtual-terminal "tty2")
-                  (login-program (log-to-info))
-                  (auto-login "guest")))
-
-        ;; Documentation add-on.
-        %configuration-template-service
-
-        ;; A bunch of 'root' ttys.
-        (normal-tty "tty3")
-        (normal-tty "tty4")
-        (normal-tty "tty5")
-        (normal-tty "tty6")
-
-        ;; The usual services.
-        (syslog-service)
-
-        ;; The build daemon.  Register the hydra.gnu.org key as trusted.
-        ;; This allows the installation process to use substitutes by
-        ;; default.
-        (service guix-service-type
-                 (guix-configuration (authorize-key? #t)))
-
-        ;; Start udev so that useful device nodes are available.
-        ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
-        ;; regulations-compliant WiFi access.
-        (udev-service #:rules (list lvm2 crda))
-
-        ;; Add the 'cow-store' service, which users have to start manually
-        ;; since it takes the installation directory as an argument.
-        (cow-store-service)
-
-        ;; To facilitate copy/paste.
-        (service gpm-service-type)
-
-        ;; Add an SSH server to facilitate remote installs.
-        (service openssh-service-type
-                 (openssh-configuration
-                  (port-number 22)
-                  (permit-root-login #t)
-                  ;; The root account is passwordless, so make sure
-                  ;; a password is set before allowing logins.
-                  (allow-empty-passwords? #f)
-                  (password-authentication? #t)
-
-                  ;; Don't start it upfront.
-                  (%auto-start? #f)))
-
-        ;; Since this is running on a USB stick with a overlayfs as the root
-        ;; file system, use an appropriate cache configuration.
-        (nscd-service (nscd-configuration
-                       (caches %nscd-minimal-caches)))
-
-        ;; Having /bin/sh is a good idea.  In particular it allows Tramp
-        ;; connections to this system to work.
-        (service special-files-service-type
-                 `(("/bin/sh" ,(file-append (canonical-package bash)
-                                            "/bin/sh"))))
-
-        ;; Loopback device, needed by OpenSSH notably.
-        (service static-networking-service-type
-                 (list (static-networking (interface "lo")
-                                          (ip "127.0.0.1")
-                                          (requirement '())
-                                          (provision '(loopback)))))
-
-        (service wpa-supplicant-service-type)
-        (dbus-service)
-        (service connman-service-type
-                 (connman-configuration
-                  (disable-vpn? #t)))
-
-        ;; Keep a reference to BARE-BONES-OS to make sure it can be
-        ;; installed without downloading/building anything.  Also keep the
-        ;; things needed by 'profile-derivation' to minimize the amount of
-        ;; download.
-        (service gc-root-service-type
-                 (list bare-bones-os
-                       glibc-utf8-locales
-                       texinfo
-                       (canonical-package guile-2.2)))))
+  (let ((motd (plain-file "motd" "
+\x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m
+
+\x1b[2mThere is NO WARRANTY, to the extent permitted by law.  In particular, 
you may
+LOSE ALL YOUR DATA as a side effect of the installation process.  Furthermore,
+it is 'beta' software, so it may contain bugs.
+
+You have been warned.  Thanks for being so brave.\x1b[0m
+")))
+    (define (normal-tty tty)
+      (mingetty-service (mingetty-configuration (tty tty)
+                                                (auto-login "root")
+                                                (login-pause? #t))))
+
+    (define bare-bones-os
+      (load "examples/bare-bones.tmpl"))
+
+    (list (service virtual-terminal-service-type)
+
+          (service kmscon-service-type
+                   (kmscon-configuration
+                    (virtual-terminal "tty1")
+                    (login-program (installer-program-launcher
+                                    newt-installer))))
+
+          (login-service (login-configuration
+                          (motd motd)))
+
+          ;; Documentation.  The manual is in UTF-8, but
+          ;; 'console-font-service' sets up Unicode support and loads a font
+          ;; with all the useful glyphs like em dash and quotation marks.
+          (mingetty-service (mingetty-configuration
+                             (tty "tty2")
+                             (auto-login "guest")
+                             (login-program (log-to-info))))
+
+          ;; Documentation add-on.
+          %configuration-template-service
+
+          ;; A bunch of 'root' ttys.
+          (normal-tty "tty3")
+          (normal-tty "tty4")
+          (normal-tty "tty5")
+          (normal-tty "tty6")
+
+          ;; The usual services.
+          (syslog-service)
+
+          ;; The build daemon.  Register the hydra.gnu.org key as trusted.
+          ;; This allows the installation process to use substitutes by
+          ;; default.
+          (service guix-service-type
+                   (guix-configuration (authorize-key? #t)))
+
+          ;; Start udev so that useful device nodes are available.
+          ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
+          ;; regulations-compliant WiFi access.
+          (udev-service #:rules (list lvm2 crda))
+
+          ;; Add the 'cow-store' service, which users have to start manually
+          ;; since it takes the installation directory as an argument.
+          (cow-store-service)
+
+          ;; Install Unicode support and a suitable font.  Use a font that
+          ;; doesn't have more than 256 glyphs so that we can use colors with
+          ;; varying brightness levels (see note in setfont(8)).
+          (service console-font-service-type
+                   (map (lambda (tty)
+                          (cons tty "lat9u-16"))
+                        '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
+
+          ;; To facilitate copy/paste.
+          (service gpm-service-type)
+
+          ;; Add an SSH server to facilitate remote installs.
+          (service openssh-service-type
+                   (openssh-configuration
+                    (port-number 22)
+                    (permit-root-login #t)
+                    ;; The root account is passwordless, so make sure
+                    ;; a password is set before allowing logins.
+                    (allow-empty-passwords? #f)
+                    (password-authentication? #t)
+
+                    ;; Don't start it upfront.
+                    (%auto-start? #f)))
+
+          ;; Since this is running on a USB stick with a overlayfs as the root
+          ;; file system, use an appropriate cache configuration.
+          (nscd-service (nscd-configuration
+                         (caches %nscd-minimal-caches)))
+
+          ;; Having /bin/sh is a good idea.  In particular it allows Tramp
+          ;; connections to this system to work.
+          (service special-files-service-type
+                   `(("/bin/sh" ,(file-append (canonical-package bash)
+                                              "/bin/sh"))))
+
+          ;; Loopback device, needed by OpenSSH notably.
+          (service static-networking-service-type
+                   (list (static-networking (interface "lo")
+                                            (ip "127.0.0.1")
+                                            (requirement '())
+                                            (provision '(loopback)))))
+
+          (service wpa-supplicant-service-type)
+          (dbus-service)
+          (service connman-service-type
+                   (connman-configuration
+                    (disable-vpn? #t)))
+
+          ;; Keep a reference to BARE-BONES-OS to make sure it can be
+          ;; installed without downloading/building anything.  Also keep the
+          ;; things needed by 'profile-derivation' to minimize the amount of
+          ;; download.
+          (service gc-root-service-type
+                   (list bare-bones-os
+                         glibc-utf8-locales
+                         texinfo
+                         (canonical-package guile-2.2))))))
 
 (define %issue
   ;; Greeting.
@@ -361,18 +375,13 @@ the user's target storage device rather than on the RAM 
disk."
                   %shared-memory-file-system
                   %immutable-store)))
 
-    (users (list
-            (user-account
-             (inherit %root-account)
-             ;; Launch the graphical installer.
-             (shell (installer-program newt-installer)))
-            (user-account
-             (name "guest")
-             (group "users")
-             (supplementary-groups '("wheel")) ; allow use of sudo
-             (password "")
-             (comment "Guest of GNU")
-             (home-directory "/home/guest"))))
+    (users (list (user-account
+                  (name "guest")
+                  (group "users")
+                  (supplementary-groups '("wheel")) ; allow use of sudo
+                  (password "")
+                  (comment "Guest of GNU")
+                  (home-directory "/home/guest"))))
 
     (issue %issue)
     (services %installation-services)