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.
This commit is contained in:
Ludovic Courtès 2019-11-29 14:53:22 +01:00
parent 403604c31e
commit 55e1dfa4dd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 21 additions and 12 deletions

View file

@ -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))

View file

@ -866,11 +866,7 @@ (define (transform-entry entry)
;; 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)

View file

@ -866,11 +866,7 @@ (define (guix-pull . args)
(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?

View file

@ -47,8 +47,8 @@ (define-module (guix ui)
#: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 @@ (define-module (guix ui)
package-relevance
display-search-results
with-profile-lock
string->generations
string->duration
matching-generations
@ -1663,6 +1664,21 @@ (define (display-diff profile old new)
(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."