mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
installer: Fix cow-store umount.
This fixes <https://bugs.gnu.org/39712>. The guix-daemon was preventing the cow-store umount, so restart it. Some udevd workers, using cow-store files might also still be around, so have some umount retries. * gnu/installer/final.scm (kill-cow-users): New procedure, (umount-cow-store): restart guix-daemon and kill all processes started from within the cow-store before trying to umount the store overlay. Also try 5 times to umount the overlay in case it is still busy.
This commit is contained in:
parent
ccb1a8c437
commit
64704be417
1 changed files with 71 additions and 6 deletions
|
@ -28,6 +28,12 @@ (define-module (gnu installer final)
|
||||||
#:use-module (gnu build accounts)
|
#:use-module (gnu build accounts)
|
||||||
#: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 (ice-9 ftw)
|
||||||
|
#:use-module (ice-9 popen)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
|
#:use-module (ice-9 rdelim)
|
||||||
#:export (install-system))
|
#:export (install-system))
|
||||||
|
|
||||||
(define %seed
|
(define %seed
|
||||||
|
@ -97,14 +103,73 @@ (define-values (group password shadow)
|
||||||
(write-passwd password (string-append etc "/passwd"))
|
(write-passwd password (string-append etc "/passwd"))
|
||||||
(write-shadow shadow (string-append etc "/shadow")))
|
(write-shadow shadow (string-append etc "/shadow")))
|
||||||
|
|
||||||
|
(define* (kill-cow-users cow-path #:key (spare '("udevd")))
|
||||||
|
"Kill all processes that have references to the given COW-PATH in their
|
||||||
|
'maps' file. The process whose names are in SPARE list are spared."
|
||||||
|
(define %not-nul
|
||||||
|
(char-set-complement (char-set #\nul)))
|
||||||
|
|
||||||
|
(let ((pids
|
||||||
|
(filter-map (lambda (pid)
|
||||||
|
(call-with-input-file
|
||||||
|
(string-append "/proc/" pid "/maps")
|
||||||
|
(lambda (port)
|
||||||
|
(and (string-contains (get-string-all port)
|
||||||
|
cow-path)
|
||||||
|
(string->number pid)))))
|
||||||
|
(scandir "/proc" string->number))))
|
||||||
|
(for-each (lambda (pid)
|
||||||
|
;; cmdline does not always exist.
|
||||||
|
(false-if-exception
|
||||||
|
(call-with-input-file
|
||||||
|
(string-append "/proc/" (number->string pid) "/cmdline")
|
||||||
|
(lambda (port)
|
||||||
|
(match (string-tokenize (read-string port) %not-nul)
|
||||||
|
((argv0 _ ...)
|
||||||
|
(unless (member (pk (basename argv0)) spare)
|
||||||
|
(syslog "Killing process ~a~%" pid)
|
||||||
|
(kill pid SIGKILL)))
|
||||||
|
(_ #f))))))
|
||||||
|
pids)))
|
||||||
|
|
||||||
(define (umount-cow-store)
|
(define (umount-cow-store)
|
||||||
"Remove the store overlay and the bind-mount on /tmp created by the
|
"Remove the store overlay and the bind-mount on /tmp created by the
|
||||||
cow-store service."
|
cow-store service. This procedure is very fragile and a better approach would
|
||||||
(let ((tmp-dir "/remove"))
|
be much appreciated."
|
||||||
(mkdir-p tmp-dir)
|
|
||||||
(mount (%store-directory) tmp-dir "" MS_MOVE)
|
;; Remove when integrated in (gnu services herd).
|
||||||
(umount tmp-dir)
|
(define (restart-service name)
|
||||||
(umount "/tmp")))
|
(with-shepherd-action name ('restart) result
|
||||||
|
result))
|
||||||
|
|
||||||
|
(catch #t
|
||||||
|
(lambda ()
|
||||||
|
(let ((tmp-dir "/remove"))
|
||||||
|
(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)
|
||||||
|
|
||||||
|
;; 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))
|
||||||
|
(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.
|
||||||
|
|
Loading…
Reference in a new issue