[bug#42849] [PATCH 3/3] installer: Run the installation inside a container.

[Mathieu Othacehe]

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/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.
* 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.
---
 gnu/installer/final.scm      | 125 +++++++++++++++++------------------
 gnu/installer/newt/final.scm |   7 --
 gnu/services/base.scm        |  60 ++++++++++-------
 3 files changed, 99 insertions(+), 93 deletions(-)

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 685aa81d89..a19018dc85 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,51 @@ 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.
+             (umount-cow-store (%installer-target-dir) backing-directory)
+             (assert-exit ret))))
+       #:namespaces '(mnt)
+       #:jail? #f))))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index fa8d6fea71..89684c4d8a 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 491f35702a..f62fd861ca 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1558,36 +1558,50 @@ 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)))
            (start
-            #~(lambda _
+            #~(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
-                 (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.
+                 (append
+                  (match args
+                    ((pid)
+                     (list #$(file-append util-linux "/bin/nsenter")
+                           "-t" pid "-m"))
+                    (else '()))
+                  (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
-- 
2.28.0