aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el1
-rw-r--r--guix/scripts/package.scm6
-rw-r--r--guix/scripts/pull.scm6
-rw-r--r--guix/ui.scm20
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."