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-directory-excursion 'scheme-indent-function 1))
|
||||||
(eval . (put 'with-file-lock '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-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 'package 'scheme-indent-function 0))
|
||||||
(eval . (put 'origin '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
|
;; First, acquire a lock on the profile, to ensure only one guix process
|
||||||
;; is modifying it at a time.
|
;; is modifying it at a time.
|
||||||
(with-file-lock/no-wait (string-append profile ".lock")
|
(with-profile-lock profile
|
||||||
(lambda (key . args)
|
|
||||||
(leave (G_ "profile ~a is locked by another process~%")
|
|
||||||
profile))
|
|
||||||
|
|
||||||
;; Then, process roll-backs, generation removals, etc.
|
;; Then, process roll-backs, generation removals, etc.
|
||||||
(for-each (match-lambda
|
(for-each (match-lambda
|
||||||
((key . arg)
|
((key . arg)
|
||||||
|
|
|
@ -866,11 +866,7 @@ (define (guix-pull . args)
|
||||||
(if (assoc-ref opts 'bootstrap?)
|
(if (assoc-ref opts 'bootstrap?)
|
||||||
%bootstrap-guile
|
%bootstrap-guile
|
||||||
(canonical-package guile-2.2)))))
|
(canonical-package guile-2.2)))))
|
||||||
(with-file-lock/no-wait (string-append profile ".lock")
|
(with-profile-lock profile
|
||||||
(lambda (key . args)
|
|
||||||
(leave (G_ "profile ~a is locked by another process~%")
|
|
||||||
profile))
|
|
||||||
|
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
(build-and-install instances profile
|
(build-and-install instances profile
|
||||||
#:dry-run?
|
#:dry-run?
|
||||||
|
|
20
guix/ui.scm
20
guix/ui.scm
|
@ -47,8 +47,8 @@ (define-module (guix ui)
|
||||||
#:use-module ((guix licenses)
|
#:use-module ((guix licenses)
|
||||||
#:select (license? license-name license-uri))
|
#:select (license? license-name license-uri))
|
||||||
#:use-module ((guix build syscalls)
|
#:use-module ((guix build syscalls)
|
||||||
#:select (free-disk-space terminal-columns
|
#:select (free-disk-space terminal-columns terminal-rows
|
||||||
terminal-rows))
|
with-file-lock/no-wait))
|
||||||
#:use-module ((guix build utils)
|
#:use-module ((guix build utils)
|
||||||
;; XXX: All we need are the bindings related to
|
;; XXX: All we need are the bindings related to
|
||||||
;; '&invoke-error'. However, to work around the bug described
|
;; '&invoke-error'. However, to work around the bug described
|
||||||
|
@ -119,6 +119,7 @@ (define-module (guix ui)
|
||||||
package-relevance
|
package-relevance
|
||||||
display-search-results
|
display-search-results
|
||||||
|
|
||||||
|
with-profile-lock
|
||||||
string->generations
|
string->generations
|
||||||
string->duration
|
string->duration
|
||||||
matching-generations
|
matching-generations
|
||||||
|
@ -1663,6 +1664,21 @@ (define (display-diff profile old new)
|
||||||
|
|
||||||
(display-diff profile gen1 gen2))
|
(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)
|
(define (display-profile-content profile number)
|
||||||
"Display the packages in PROFILE, generation NUMBER, in a human-readable
|
"Display the packages in PROFILE, generation NUMBER, in a human-readable
|
||||||
way."
|
way."
|
||||||
|
|
Loading…
Reference in a new issue