diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/install.scm | 23 |
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)))) |
