installer: Run the installation inside a container.

When the store overlay is mounted, other processes such as kmscon, udev
and guix-daemon may open files from the store, preventing the
underlying install support from being umounted. See:
https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.

To avoid this situation, mount the store overlay inside a container,
and run the installation from within that container.

* gnu/build/shepherd.scm (fork+exec-command/container): New procedure.
* gnu/services/base.scm (guix-shepherd-service): Support an optional PID
argument passed to the "start" method. If that argument is passed, ensure that
guix-daemon enters the given PID MNT namespace by using
fork+exec-command/container procedure.
* gnu/installer/final.scm (umount-cow-store): Remove it,
(install-system): run the installation from within a container.
* gnu/installer/newt/final.scm (run-install-shell): Remove the display hack.

4 files changed, 142 insertions, 122 deletions

diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index fd93e7f3f43..65141bd60f8 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -20,10 +20,12 @@
   #:use-module (gnu system file-systems)
   #:use-module (gnu build linux-container)
   #:use-module (guix build utils)
+  #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (make-forkexec-constructor/container))
+  #:export (make-forkexec-constructor/container
+            fork+exec-command/container))
 
 ;;; Commentary:
 ;;;
@@ -93,7 +95,8 @@
 ;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
 (module-autoload! (current-module)
                   '(shepherd service)
-                  '(read-pid-file exec-command %precious-signals))
+                  '(fork+exec-command read-pid-file exec-command
+                    %precious-signals))
 (module-autoload! (current-module)
                   '(shepherd system) '(unblock-signals))
 
@@ -188,6 +191,17 @@ namespace, in addition to essential bind-mounts such /proc."
               (read-pid-file pid-file #:max-delay pid-file-timeout))
           pid))))
 
+(define* (fork+exec-command/container command
+                                      #:key pid
+                                      #:allow-other-keys
+                                      #:rest args)
+  "This is a variant of 'fork+exec-command' procedure, that joins the
+namespaces of process PID beforehand."
+  (container-excursion* pid
+    (lambda ()
+      (apply fork+exec-command command
+             (strip-keyword-arguments '(#:pid) args)))))
+
 ;; Local Variables:
 ;; eval: (put 'container-excursion* 'scheme-indent-function 1)
 ;; End:
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 685aa81d89b..11143b2adbe 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -26,6 +26,8 @@
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
   #:use-module (gnu build accounts)
+  #:use-module (gnu build install)
+  #:use-module (gnu build linux-container)
   #:use-module ((gnu system shadow) #:prefix sys:)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -133,49 +135,18 @@ USERS."
                        (_ #f))))))
               pids)))
 
-(define (umount-cow-store)
-  "Remove the store overlay and the bind-mount on /tmp created by the
-cow-store service.  This procedure is very fragile and a better approach would
-be much appreciated."
-  (catch #t
-    (lambda ()
-      (let ((tmp-dir "/remove"))
-        (syslog "Unmounting cow-store.~%")
-
-        (mkdir-p tmp-dir)
-        (mount (%store-directory) tmp-dir "" MS_MOVE)
-
-        ;; The guix-daemon has possibly opened files from the cow-store,
-        ;; restart it.
-        (restart-service 'guix-daemon)
-
-        (syslog "Killing cow users.")
-
-        ;; Kill all processes started while the cow-store was active (logins
-        ;; on other TTYs for instance).
-        (kill-cow-users tmp-dir)
-
-        ;; Try to umount the store overlay. Some process such as udevd
-        ;; workers might still be active, so do some retries.
-        (let loop ((try 5))
-          (syslog "Umount try ~a~%" (- 5 try))
-          (sleep 1)
-          (let ((umounted? (false-if-exception (umount tmp-dir))))
-            (if (and (not umounted?) (> try 0))
-                (loop (- try 1))
-                (if umounted?
-                    (syslog "Umounted ~a successfully.~%" tmp-dir)
-                    (syslog "Failed to umount ~a.~%" tmp-dir)))))
-
-        (umount "/tmp")))
-    (lambda args
-      (syslog "~a~%" args))))
-
 (define* (install-system locale #:key (users '()))
   "Create /etc/shadow and /etc/passwd on the installation target for USERS.
 Start COW-STORE service on target directory and launch guix install command in
 a subshell.  LOCALE must be the locale name under which that command will run,
 or #f.  Return #t on success and #f on failure."
+  (define backing-directory
+    ;; Sub-directory used as the backing store for copy-on-write.
+    "/tmp/guix-inst")
+
+  (define (assert-exit x)
+    (primitive-exit (if x 0 1)))
+
   (let* ((options         (catch 'system-error
                             (lambda ()
                               ;; If this file exists, it can provide
@@ -188,7 +159,11 @@ or #f.  Return #t on success and #f on failure."
                                         "--fallback")
                                   options
                                   (list (%installer-configuration-file)
-                                        (%installer-target-dir)))))
+                                        (%installer-target-dir))))
+         (database-dir    "/var/guix/db")
+         (database-file   (string-append database-dir "/db.sqlite"))
+         (saved-database  (string-append database-dir "/db.save"))
+         (ret             #f))
     (mkdir-p (%installer-target-dir))
 
     ;; We want to initialize user passwords but we don't want to store them in
@@ -198,27 +173,50 @@ or #f.  Return #t on success and #f on failure."
     ;; passwords that we've put in there.
     (create-user-database users (%installer-target-dir))
 
-    (dynamic-wind
-      (lambda ()
-        (start-service 'cow-store (list (%installer-target-dir))))
-      (lambda ()
-        ;; If there are any connected clients, assume that we are running
-        ;; installation tests. In that case, dump the standard and error
-        ;; outputs to syslog.
-        (if (not (null? (current-clients)))
-            (with-output-to-file "/dev/console"
-              (lambda ()
-                (with-error-to-file "/dev/console"
-                  (lambda ()
-                    (setvbuf (current-output-port) 'none)
-                    (setvbuf (current-error-port) 'none)
-                    (run-command install-command #:locale locale)))))
-            (run-command install-command #:locale locale)))
-      (lambda ()
-        (stop-service 'cow-store)
-        ;; Remove the store overlay created at cow-store service start.
-        ;; Failing to do that will result in further umount calls to fail
-        ;; because the target device is seen as busy. See:
-        ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
-        (umount-cow-store)
-        #f))))
+    ;; When the store overlay is mounted, other processes such as kmscon, udev
+    ;; and guix-daemon may open files from the store, preventing the
+    ;; underlying install support from being umounted. See:
+    ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
+    ;;
+    ;; To avoid this situation, mount the store overlay inside a container,
+    ;; and run the installation from within that container.
+    (zero?
+     (call-with-container '()
+       (lambda ()
+         (dynamic-wind
+           (lambda ()
+             ;; Save the database, so that it can be restored once the
+             ;; cow-store is umounted.
+             (copy-file database-file saved-database)
+             (mount-cow-store (%installer-target-dir) backing-directory))
+           (lambda ()
+             ;; We need to drag the guix-daemon to the container MNT
+             ;; namespace, so that it can operate on the cow-store.
+             (stop-service 'guix-daemon)
+             (start-service 'guix-daemon (list (number->string (getpid))))
+
+             (setvbuf (current-output-port) 'none)
+             (setvbuf (current-error-port) 'none)
+
+             ;; If there are any connected clients, assume that we are running
+             ;; installation tests. In that case, dump the standard and error
+             ;; outputs to syslog.
+             (set! ret
+                   (if (not (null? (current-clients)))
+                       (with-output-to-file "/dev/console"
+                         (lambda ()
+                           (with-error-to-file "/dev/console"
+                             (lambda ()
+                               (run-command install-command
+                                            #:locale locale)))))
+                       (run-command install-command #:locale locale))))
+           (lambda ()
+             ;; Restart guix-daemon so that it does no keep the MNT namespace
+             ;; alive.
+             (restart-service 'guix-daemon)
+             (copy-file saved-database database-file)
+
+             ;; Finally umount the cow-store and exit the container.
+             (unmount-cow-store (%installer-target-dir) backing-directory)
+             (assert-exit ret))))
+       #:namespaces '(mnt)))))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index fa8d6fea718..89684c4d8ad 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -102,13 +102,6 @@ a specific step, or restart the installer."))
                             #:key (users '()))
   (clear-screen)
   (newt-suspend)
-  ;; XXX: Force loading 'bold' font files before mouting the
-  ;; cow-store. Otherwise, if the file is loaded by kmscon after the cow-store
-  ;; in mounted, it will be necessary to kill kmscon to umount to cow-store.
-  (display
-   (colorize-string
-    (format #f (G_ "Installing Guix System ...~%"))
-    (color BOLD)))
   (let ((install-ok? (install-system locale #:users users)))
     (newt-resume)
     install-ok?))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 491f35702a0..d560ad5a13b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1558,57 +1558,72 @@ proxy of 'guix-daemon'...~%")
            (provision '(guix-daemon))
            (requirement '(user-processes))
            (actions (list shepherd-set-http-proxy-action))
-           (modules '((srfi srfi-1)))
+           (modules '((srfi srfi-1)
+                      (ice-9 match)
+                      (gnu build shepherd)))
            (start
-            #~(lambda _
-                (define proxy
-                  ;; HTTP/HTTPS proxy.  The 'http_proxy' variable is set by
-                  ;; the 'set-http-proxy' action.
-                  (or (getenv "http_proxy") #$http-proxy))
-
-                (fork+exec-command
-                 (cons* #$(file-append guix "/bin/guix-daemon")
-                        "--build-users-group" #$build-group
-                        "--max-silent-time" #$(number->string max-silent-time)
-                        "--timeout" #$(number->string timeout)
-                        "--log-compression" #$(symbol->string log-compression)
-                        #$@(if use-substitutes?
-                               '()
-                               '("--no-substitutes"))
-                        "--substitute-urls" #$(string-join substitute-urls)
-                        #$@extra-options
-
-                        ;; Add CHROOT-DIRECTORIES and all their dependencies
-                        ;; (if these are store items) to the chroot.
-                        (append-map (lambda (file)
-                                      (append-map (lambda (directory)
-                                                    (list "--chroot-directory"
-                                                          directory))
-                                                  (call-with-input-file file
-                                                    read)))
-                                    '#$(map references-file
-                                            chroot-directories)))
-
-                 #:environment-variables
-                 (append (list #$@(if tmpdir
-                                      (list (string-append "TMPDIR=" tmpdir))
-                                      '())
-
-                               ;; Make sure we run in a UTF-8 locale so that
-                               ;; 'guix offload' correctly restores nars that
-                               ;; contain UTF-8 file names such as
-                               ;; 'nss-certs'.  See
-                               ;; <https://bugs.gnu.org/32942>.
-                               (string-append "GUIX_LOCPATH="
-                                              #$glibc-utf8-locales
-                                              "/lib/locale")
-                               "LC_ALL=en_US.utf8")
-                         (if proxy
-                             (list (string-append "http_proxy=" proxy)
-                                   (string-append "https_proxy=" proxy))
-                             '()))
-
-                 #:log-file #$log-file)))
+            (with-imported-modules (source-module-closure
+                                    '((gnu build shepherd)))
+              #~(lambda args
+                  (define proxy
+                    ;; HTTP/HTTPS proxy.  The 'http_proxy' variable is set by
+                    ;; the 'set-http-proxy' action.
+                    (or (getenv "http_proxy") #$http-proxy))
+
+                  (fork+exec-command/container
+                   (cons* #$(file-append guix "/bin/guix-daemon")
+                          "--build-users-group" #$build-group
+                          "--max-silent-time"
+                          #$(number->string max-silent-time)
+                          "--timeout" #$(number->string timeout)
+                          "--log-compression"
+                          #$(symbol->string log-compression)
+                          #$@(if use-substitutes?
+                                 '()
+                                 '("--no-substitutes"))
+                          "--substitute-urls" #$(string-join substitute-urls)
+                          #$@extra-options
+
+                          ;; Add CHROOT-DIRECTORIES and all their dependencies
+                          ;; (if these are store items) to the chroot.
+                          (append-map
+                           (lambda (file)
+                             (append-map (lambda (directory)
+                                           (list "--chroot-directory"
+                                                 directory))
+                                         (call-with-input-file file
+                                           read)))
+                           '#$(map references-file
+                                   chroot-directories)))
+
+                   ;; When running the installer, we need guix-daemon to
+                   ;; operate from within the same MNT namespace as the
+                   ;; installation container. In that case only, enter the
+                   ;; namespace of the process PID passed as start argument.
+                   #:pid (match args
+                           ((pid) (string->number pid))
+                           (else (getpid)))
+
+                   #:environment-variables
+                   (append (list #$@(if tmpdir
+                                        (list (string-append "TMPDIR=" tmpdir))
+                                        '())
+
+                                 ;; Make sure we run in a UTF-8 locale so that
+                                 ;; 'guix offload' correctly restores nars
+                                 ;; that contain UTF-8 file names such as
+                                 ;; 'nss-certs'.  See
+                                 ;; <https://bugs.gnu.org/32942>.
+                                 (string-append "GUIX_LOCPATH="
+                                                #$glibc-utf8-locales
+                                                "/lib/locale")
+                                 "LC_ALL=en_US.utf8")
+                           (if proxy
+                               (list (string-append "http_proxy=" proxy)
+                                     (string-append "https_proxy=" proxy))
+                               '()))
+
+                   #:log-file #$log-file))))
            (stop #~(make-kill-destructor))))))
 
 (define (guix-accounts config)