mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
403604c31e
commit
55e1dfa4dd
4 changed files with 21 additions and 12 deletions
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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?
|
||||
|
|
20
guix/ui.scm
20
guix/ui.scm
|
@ -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."
|
||||
|
|
Loading…
Reference in a new issue