summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/shepherd.scm18
-rw-r--r--gnu/installer/final.scm124
-rw-r--r--gnu/installer/newt/final.scm7
-rw-r--r--gnu/services/base.scm115
4 files changed, 142 insertions, 122 deletions
diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index fd93e7f3f4..65141bd60f 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 685aa81d89..11143b2adb 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 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..d560ad5a13 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)