05/07: ui: Factorize 'with-profile-lock'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 55e1dfa4dd189e010c541e3997b65434c702b4a5
Author: Ludovic Courtès <address@hidden>
Date:   Fri Nov 29 14:53:22 2019 +0100

    ui: Factorize 'with-profile-lock'.
    
    * guix/ui.scm (profile-lock-handler, profile-lock-file): New
    procedures.
    (with-profile-lock): New macro.
    * guix/scripts/package.scm (process-actions): Use 'with-profile-lock'
    instead of 'with-file-lock/no-wait'.
    * guix/scripts/pull.scm (guix-pull): Likewise.
---
 .dir-locals.el           |  1 +
 guix/scripts/package.scm |  6 +-----
 guix/scripts/pull.scm    |  6 +-----
 guix/ui.scm              | 20 ++++++++++++++++++--
 4 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index e4947f5..5ce3fbc 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 97436fe..92c6e34 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 7f37c15..19410ad 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 b7d5516..f4aa6e2 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."