Skip to content
Snippets Groups Projects
Unverified Commit 8ce6f4dc authored by Mathieu Othacehe's avatar Mathieu Othacehe
Browse files

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.
parent 5316dfc0
No related branches found
No related tags found
No related merge requests found
...@@ -20,10 +20,12 @@ (define-module (gnu build shepherd) ...@@ -20,10 +20,12 @@ (define-module (gnu build shepherd)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu build linux-container) #:use-module (gnu build linux-container)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (make-forkexec-constructor/container)) #:export (make-forkexec-constructor/container
fork+exec-command/container))
;;; Commentary: ;;; Commentary:
;;; ;;;
...@@ -93,7 +95,8 @@ (define accounts ...@@ -93,7 +95,8 @@ (define accounts
;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency. ;; XXX: Lazy-bind the Shepherd to avoid a compile-time dependency.
(module-autoload! (current-module) (module-autoload! (current-module)
'(shepherd service) '(shepherd service)
'(read-pid-file exec-command %precious-signals)) '(fork+exec-command read-pid-file exec-command
%precious-signals))
(module-autoload! (current-module) (module-autoload! (current-module)
'(shepherd system) '(unblock-signals)) '(shepherd system) '(unblock-signals))
...@@ -188,6 +191,17 @@ (define mounts ...@@ -188,6 +191,17 @@ (define mounts
(read-pid-file pid-file #:max-delay pid-file-timeout)) (read-pid-file pid-file #:max-delay pid-file-timeout))
pid)))) 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: ;; Local Variables:
;; eval: (put 'container-excursion* 'scheme-indent-function 1) ;; eval: (put 'container-excursion* 'scheme-indent-function 1)
;; End: ;; End:
......
...@@ -26,6 +26,8 @@ (define-module (gnu installer final) ...@@ -26,6 +26,8 @@ (define-module (gnu installer final)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu build accounts) #: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 ((gnu system shadow) #:prefix sys:)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
...@@ -133,49 +135,18 @@ (define %not-nul ...@@ -133,49 +135,18 @@ (define %not-nul
(_ #f)))))) (_ #f))))))
pids))) 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 '())) (define* (install-system locale #:key (users '()))
"Create /etc/shadow and /etc/passwd on the installation target for 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 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, a subshell. LOCALE must be the locale name under which that command will run,
or #f. Return #t on success and #f on failure." 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 (let* ((options (catch 'system-error
(lambda () (lambda ()
;; If this file exists, it can provide ;; If this file exists, it can provide
...@@ -188,7 +159,11 @@ (define* (install-system locale #:key (users '())) ...@@ -188,7 +159,11 @@ (define* (install-system locale #:key (users '()))
"--fallback") "--fallback")
options options
(list (%installer-configuration-file) (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)) (mkdir-p (%installer-target-dir))
;; We want to initialize user passwords but we don't want to store them in ;; We want to initialize user passwords but we don't want to store them in
...@@ -198,27 +173,50 @@ (define* (install-system locale #:key (users '())) ...@@ -198,27 +173,50 @@ (define* (install-system locale #:key (users '()))
;; passwords that we've put in there. ;; passwords that we've put in there.
(create-user-database users (%installer-target-dir)) (create-user-database users (%installer-target-dir))
(dynamic-wind ;; When the store overlay is mounted, other processes such as kmscon, udev
(lambda () ;; and guix-daemon may open files from the store, preventing the
(start-service 'cow-store (list (%installer-target-dir)))) ;; underlying install support from being umounted. See:
(lambda () ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
;; If there are any connected clients, assume that we are running ;;
;; installation tests. In that case, dump the standard and error ;; To avoid this situation, mount the store overlay inside a container,
;; outputs to syslog. ;; and run the installation from within that container.
(if (not (null? (current-clients))) (zero?
(with-output-to-file "/dev/console" (call-with-container '()
(lambda () (lambda ()
(with-error-to-file "/dev/console" (dynamic-wind
(lambda () (lambda ()
(setvbuf (current-output-port) 'none) ;; Save the database, so that it can be restored once the
(setvbuf (current-error-port) 'none) ;; cow-store is umounted.
(run-command install-command #:locale locale))))) (copy-file database-file saved-database)
(run-command install-command #:locale locale))) (mount-cow-store (%installer-target-dir) backing-directory))
(lambda () (lambda ()
(stop-service 'cow-store) ;; We need to drag the guix-daemon to the container MNT
;; Remove the store overlay created at cow-store service start. ;; namespace, so that it can operate on the cow-store.
;; Failing to do that will result in further umount calls to fail (stop-service 'guix-daemon)
;; because the target device is seen as busy. See: (start-service 'guix-daemon (list (number->string (getpid))))
;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
(umount-cow-store) (setvbuf (current-output-port) 'none)
#f)))) (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)))))
...@@ -102,13 +102,6 @@ (define* (run-install-shell locale ...@@ -102,13 +102,6 @@ (define* (run-install-shell locale
#:key (users '())) #:key (users '()))
(clear-screen) (clear-screen)
(newt-suspend) (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))) (let ((install-ok? (install-system locale #:users users)))
(newt-resume) (newt-resume)
install-ok?)) install-ok?))
......
...@@ -1558,57 +1558,72 @@ (define (guix-shepherd-service config) ...@@ -1558,57 +1558,72 @@ (define (guix-shepherd-service config)
(provision '(guix-daemon)) (provision '(guix-daemon))
(requirement '(user-processes)) (requirement '(user-processes))
(actions (list shepherd-set-http-proxy-action)) (actions (list shepherd-set-http-proxy-action))
(modules '((srfi srfi-1))) (modules '((srfi srfi-1)
(ice-9 match)
(gnu build shepherd)))
(start (start
#~(lambda _ (with-imported-modules (source-module-closure
(define proxy '((gnu build shepherd)))
;; HTTP/HTTPS proxy. The 'http_proxy' variable is set by #~(lambda args
;; the 'set-http-proxy' action. (define proxy
(or (getenv "http_proxy") #$http-proxy)) ;; HTTP/HTTPS proxy. The 'http_proxy' variable is set by
;; the 'set-http-proxy' action.
(fork+exec-command (or (getenv "http_proxy") #$http-proxy))
(cons* #$(file-append guix "/bin/guix-daemon")
"--build-users-group" #$build-group (fork+exec-command/container
"--max-silent-time" #$(number->string max-silent-time) (cons* #$(file-append guix "/bin/guix-daemon")
"--timeout" #$(number->string timeout) "--build-users-group" #$build-group
"--log-compression" #$(symbol->string log-compression) "--max-silent-time"
#$@(if use-substitutes? #$(number->string max-silent-time)
'() "--timeout" #$(number->string timeout)
'("--no-substitutes")) "--log-compression"
"--substitute-urls" #$(string-join substitute-urls) #$(symbol->string log-compression)
#$@extra-options #$@(if use-substitutes?
'()
;; Add CHROOT-DIRECTORIES and all their dependencies '("--no-substitutes"))
;; (if these are store items) to the chroot. "--substitute-urls" #$(string-join substitute-urls)
(append-map (lambda (file) #$@extra-options
(append-map (lambda (directory)
(list "--chroot-directory" ;; Add CHROOT-DIRECTORIES and all their dependencies
directory)) ;; (if these are store items) to the chroot.
(call-with-input-file file (append-map
read))) (lambda (file)
'#$(map references-file (append-map (lambda (directory)
chroot-directories))) (list "--chroot-directory"
directory))
#:environment-variables (call-with-input-file file
(append (list #$@(if tmpdir read)))
(list (string-append "TMPDIR=" tmpdir)) '#$(map references-file
'()) chroot-directories)))
;; Make sure we run in a UTF-8 locale so that ;; When running the installer, we need guix-daemon to
;; 'guix offload' correctly restores nars that ;; operate from within the same MNT namespace as the
;; contain UTF-8 file names such as ;; installation container. In that case only, enter the
;; 'nss-certs'. See ;; namespace of the process PID passed as start argument.
;; <https://bugs.gnu.org/32942>. #:pid (match args
(string-append "GUIX_LOCPATH=" ((pid) (string->number pid))
#$glibc-utf8-locales (else (getpid)))
"/lib/locale")
"LC_ALL=en_US.utf8") #:environment-variables
(if proxy (append (list #$@(if tmpdir
(list (string-append "http_proxy=" proxy) (list (string-append "TMPDIR=" tmpdir))
(string-append "https_proxy=" proxy)) '())
'()))
;; Make sure we run in a UTF-8 locale so that
#:log-file #$log-file))) ;; '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)))))) (stop #~(make-kill-destructor))))))
(define (guix-accounts config) (define (guix-accounts config)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment