Merge branch 'master' into staging

1 files changed, 96 insertions, 15 deletions

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 91e7b481e8..d887313132 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -27,6 +27,7 @@
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
+  #:use-module ((guix packages) #:select (package-version))
   #:use-module ((guix store) #:select (%store-prefix))
   #:use-module (gnu installer)
   #:use-module (gnu services dbus)
@@ -73,19 +74,93 @@
 ;;; Code:
 
 
-(define (log-to-info)
+;;;
+;;; Documentation service.
+;;;
+
+(define %installation-node-names
+  ;; Translated name of the "System Installation" node of the manual.  Ideally
+  ;; we'd extract it from the 'guix-manual' gettext domain, but that one is
+  ;; usually not available at run time, hence this hack.
+  '(("de" . "Systeminstallation")
+    ("en" . "System Installation")
+    ("fr" . "Installation du système")))
+
+(define (log-to-info tty user)
   "Return a script that spawns the Info reader on the right section of the
 manual."
   (program-file "log-to-info"
-                #~(begin
+                #~(let* ((tty      (open-file #$(string-append "/dev/" tty)
+                                              "r0+"))
+                         (locale   (cadr (command-line)))
+                         (language (string-take locale
+                                                (string-index locale #\_)))
+                         (infodir  "/run/current-system/profile/share/info")
+                         (per-lang (string-append infodir "/guix." language
+                                                  ".info.gz"))
+                         (file     (if (file-exists? per-lang)
+                                       per-lang
+                                       (string-append infodir "/guix.info")))
+                         (node     (or (assoc-ref '#$%installation-node-names
+                                                  language)
+                                       "System Installation")))
+                    (redirect-port tty (current-output-port))
+                    (redirect-port tty (current-error-port))
+                    (redirect-port tty (current-input-port))
+
+                    (let ((pw (getpwnam #$user)))
+                      (setgid (passwd:gid pw))
+                      (setuid (passwd:uid pw)))
+
                     ;; 'gunzip' is needed to decompress the doc.
                     (setenv "PATH" (string-append #$gzip "/bin"))
 
-                    (execl (string-append #$info-reader "/bin/info") "info"
-                           "-d" "/run/current-system/profile/share/info"
-                           "-f" (string-append #$guix "/share/info/guix.info")
-                           "-n" "System Installation"))))
+                    ;; Change this process' locale so that command-line
+                    ;; arguments to 'info' are properly encoded.
+                    (catch #t
+                      (lambda ()
+                        (setlocale LC_ALL locale)
+                        (setenv "LC_ALL" locale))
+                      (lambda _
+                        ;; Sometimes LOCALE itself is not available.  In that
+                        ;; case pick the one UTF-8 locale that's known to work
+                        ;; instead of failing.
+                        (setlocale LC_ALL "en_US.utf8")
+                        (setenv "LC_ALL" "en_US.utf8")))
+
+                    (execl #$(file-append info-reader "/bin/info")
+                           "info" "-d" infodir "-f" file "-n" node))))
+
+(define (documentation-shepherd-service tty)
+  (list (shepherd-service
+         (provision (list (symbol-append 'term- (string->symbol tty))))
+         (requirement '(user-processes host-name udev virtual-terminal))
+         (start #~(lambda* (#:optional (locale "en_US.utf8"))
+                    (fork+exec-command
+                     (list #$(log-to-info tty "documentation") locale)
+                     #:environment-variables
+                     `("GUIX_LOCPATH=/run/current-system/locale"
+                       "TERM=linux"))))
+         (stop #~(make-kill-destructor)))))
+
+(define %documentation-users
+  ;; User account for the Info viewer.
+  (list (user-account (name "documentation")
+                      (system? #t)
+                      (group "nogroup")
+                      (home-directory "/var/empty"))))
+
+(define documentation-service-type
+  ;; Documentation viewer service.
+  (service-type (name 'documentation)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          documentation-shepherd-service)
+                       (service-extension account-service-type
+                                          (const %documentation-users))))
+                (description "Run the Info reader on a tty.")))
 
+
 (define %backing-directory
   ;; Sub-directory used as the backing store for copy-on-write.
   "/tmp/guix-inst")
@@ -239,10 +314,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
           ;; 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))))
+          (service documentation-service-type "tty2")
 
           ;; Documentation add-on.
           %configuration-template-service
@@ -271,12 +343,18 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
           ;; 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)).
+          ;; Install Unicode support and a suitable font.
           (service console-font-service-type
-                   (map (lambda (tty)
-                          (cons tty "lat9u-16"))
+                   (map (match-lambda
+                          ("tty2"
+                           ;; Use a font that contains characters such as
+                           ;; curly quotes as found in the manual.
+                           '("tty2" . "LatGrkCyr-8x16"))
+                          (tty
+                           ;; 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)).
+                           `(,tty . "lat9u-16")))
                         '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 
           ;; To facilitate copy/paste.
@@ -346,6 +424,9 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
     (bootloader (bootloader-configuration
                  (bootloader grub-bootloader)
                  (target "/dev/sda")))
+    (label (string-append "GNU Guix installation "
+                          (package-version guix)))
+
     (file-systems
      ;; Note: the disk image build code overrides this root file system with
      ;; the appropriate one.