diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 6 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 6 | ||||
| -rw-r--r-- | guix/ui.scm | 20 |
4 files changed, 21 insertions, 12 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index e4947f5f10..5ce3fbc9a5 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -36,6 +36,7 @@ (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'with-file-lock 'scheme-indent-function 1)) (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1)) + (eval . (put 'with-profile-lock 'scheme-indent-function 1)) (eval . (put 'package 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 97436feee7..92c6e34194 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -866,11 +866,7 @@ processed, #f otherwise." ;; First, acquire a lock on the profile, to ensure only one guix process ;; is modifying it at a time. - (with-file-lock/no-wait (string-append profile ".lock") - (lambda (key . args) - (leave (G_ "profile ~a is locked by another process~%") - profile)) - + (with-profile-lock profile ;; Then, process roll-backs, generation removals, etc. (for-each (match-lambda ((key . arg) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 7f37c156e8..19410ad141 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -866,11 +866,7 @@ Use '~/.config/guix/channels.scm' instead.")) (if (assoc-ref opts 'bootstrap?) %bootstrap-guile (canonical-package guile-2.2))))) - (with-file-lock/no-wait (string-append profile ".lock") - (lambda (key . args) - (leave (G_ "profile ~a is locked by another process~%") - profile)) - + (with-profile-lock profile (run-with-store store (build-and-install instances profile #:dry-run? diff --git a/guix/ui.scm b/guix/ui.scm index b7d5516b5a..f4aa6e291e 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -47,8 +47,8 @@ #:use-module ((guix licenses) #:select (license? license-name license-uri)) #:use-module ((guix build syscalls) - #:select (free-disk-space terminal-columns - terminal-rows)) + #:select (free-disk-space terminal-columns terminal-rows + with-file-lock/no-wait)) #:use-module ((guix build utils) ;; XXX: All we need are the bindings related to ;; '&invoke-error'. However, to work around the bug described @@ -119,6 +119,7 @@ package-relevance display-search-results + with-profile-lock string->generations string->duration matching-generations @@ -1663,6 +1664,21 @@ DURATION-RELATION with the current time." (display-diff profile gen1 gen2)) +(define (profile-lock-handler profile errno . _) + "Handle failure to acquire PROFILE's lock." + (leave (G_ "profile ~a is locked by another process~%") + profile)) + +(define profile-lock-file + (cut string-append <> ".lock")) + +(define-syntax-rule (with-profile-lock profile exp ...) + "Grab PROFILE's lock and evaluate EXP... Call 'leave' if the lock is +already taken." + (with-file-lock/no-wait (profile-lock-file profile) + (cut profile-lock-handler profile <...>) + exp ...)) + (define (display-profile-content profile number) "Display the packages in PROFILE, generation NUMBER, in a human-readable way." |