guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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.
This commit is contained in:
Mathieu Othacehe 2020-08-13 14:16:12 +02:00
parent 5316dfc0f1
commit 8ce6f4dc28
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
4 changed files with 137 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gnu/build/shepherd.scm
View File

@ -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:

124
gnu/installer/final.scm
View File

@ -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)))))

7
gnu/installer/newt/final.scm
View File

@ -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?))

105
gnu/services/base.scm
View File

@ -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))
(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
(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
(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)))
;; 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))
'())
;; 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)))
;; 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))
'()))
#:environment-variables
(append (list #$@(if tmpdir
(list (string-append "TMPDIR=" tmpdir))
'())
#:log-file #$log-file)))
;; 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)