summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/install.scm23
1 files changed, 21 insertions, 2 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 33a9616c0d8..d4982650c18 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> 3;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
4;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> 4;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
5;;; 5;;;
@@ -282,12 +282,31 @@ disk."
282 (mount "/.rw-store" (%store-directory) "" MS_MOVE) 282 (mount "/.rw-store" (%store-directory) "" MS_MOVE)
283 (rmdir "/.rw-store"))) 283 (rmdir "/.rw-store")))
284 284
285(define (umount* directory)
286 "Unmount DIRECTORY, but retry a few times upon EBUSY."
287 (let loop ((attempts 5))
288 (catch 'system-error
289 (lambda ()
290 (umount directory))
291 (lambda args
292 (if (and (= EBUSY (system-error-errno args))
293 (> attempts 0))
294 (begin
295 (sleep 1)
296 (loop (- attempts 1)))
297 (apply throw args))))))
298
285(define (unmount-cow-store target backing-directory) 299(define (unmount-cow-store target backing-directory)
286 "Unmount copy-on-write store." 300 "Unmount copy-on-write store."
287 (let ((tmp-dir "/remove")) 301 (let ((tmp-dir "/remove"))
288 (mkdir-p tmp-dir) 302 (mkdir-p tmp-dir)
289 (mount (%store-directory) tmp-dir "" MS_MOVE) 303 (mount (%store-directory) tmp-dir "" MS_MOVE)
290 (umount tmp-dir) 304
305 ;; We might get EBUSY at this point, possibly because of lingering
306 ;; processes with open file descriptors. Use 'umount*' to retry upon
307 ;; EBUSY, leaving a bit of time. See <https://issues.guix.gnu.org/59884>.
308 (umount* tmp-dir)
309
291 (rmdir tmp-dir) 310 (rmdir tmp-dir)
292 (delete-file-recursively 311 (delete-file-recursively
293 (string-append target backing-directory)))) 312 (string-append target backing-directory))))