From: Julien Lepiller <julien@lepiller.eu>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 36375@debbugs.gnu.org
Subject: bug#36375: [PATCH] Re: ‘guix package’ should lock the profile
Date: Sat, 26 Oct 2019 00:08:06 +0200 [thread overview]
Message-ID: <20191026000806.7eb6342b@sybil.lepiller.eu> (raw)
In-Reply-To: <87tv7wldwh.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 550 bytes --]
Le Fri, 25 Oct 2019 23:21:34 +0200,
Ludovic Courtès <ludo@gnu.org> a écrit :
>
> I’d recommend wrapping the body in ‘with-file-lock’ (from (guix build
> syscalls)), which handles non-local exits.
>
> However you’d first need to add a #:wait? argument to ‘with-file-lock’
> and perhaps an additional argument to handle the already-locked case.
> Or maybe call that ‘with-file-lock/no-wait’.
>
> How does that sound?
>
> Thanks for working on it!
>
> Ludo’.
Thanks! here is a new patch with your suggestions.
[-- Attachment #2: 0001-guix-package-lock-profiles-when-processing-them.patch --]
[-- Type: text/x-patch, Size: 6626 bytes --]
From 5d86226f318a111cc1bdf5a6f044c6f540f51b45 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Fri, 25 Oct 2019 21:39:21 +0200
Subject: [PATCH] guix: package: lock profiles when processing them.
* guix/scripts/package.scm (process-actions): Get a per-profile lock to
prevent concurrent actions on profiles.
* guix/build/syscalls.scm (with-file-lock/no-wait): New procedure.
(lock-file): Take a #:wait? key.
---
guix/build/syscalls.scm | 33 ++++++++++++++++++--
guix/scripts/package.scm | 65 +++++++++++++++++++++++-----------------
2 files changed, 69 insertions(+), 29 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index bbf2531c79..d843194cce 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -80,6 +80,7 @@
lock-file
unlock-file
with-file-lock
+ with-file-lock/no-wait
set-thread-name
thread-name
@@ -1087,10 +1088,10 @@ exception if it's already taken."
;; Presumably we got EAGAIN or so.
(throw 'flock-error err))))))
-(define (lock-file file)
+(define* (lock-file file #:key (wait? #t))
"Wait and acquire an exclusive lock on FILE. Return an open port."
(let ((port (open-file file "w0")))
- (fcntl-flock port 'write-lock)
+ (fcntl-flock port 'write-lock #:wait? wait?)
port))
(define (unlock-file port)
@@ -1119,10 +1120,38 @@ exception if it's already taken."
(when port
(unlock-file port))))))
+(define (call-with-file-lock/no-wait file thunk handler)
+ (let ((port (catch 'system-error
+ (lambda ()
+ (catch 'flock-error
+ (lambda ()
+ (lock-file file #:wait? #f))
+ handler))
+ (lambda args
+ ;; When using the statically-linked Guile in the initrd,
+ ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
+ ;; that error since we're typically the only process running
+ ;; at this point.
+ (if (or (= ENOSYS (system-error-errno args)) (= 'flock-error args))
+ #f
+ (apply throw args))))))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ thunk
+ (lambda ()
+ (when port
+ (unlock-file port))))))
+
(define-syntax-rule (with-file-lock file exp ...)
"Wait to acquire a lock on FILE and evaluate EXP in that context."
(call-with-file-lock file (lambda () exp ...)))
+(define-syntax-rule (with-file-lock/no-wait file handler exp ...)
+ "Try to acquire a lock on FILE and evaluate EXP in that context. Execute
+handler if the lock is already held by another process."
+ (call-with-file-lock/no-wait file (lambda () exp ...) handler))
+
\f
;;;
;;; Miscellaneous, aka. 'prctl'.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1a58d43e5c..4776d61077 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -42,6 +42,8 @@
#:autoload (guix store roots) (gc-roots)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p))
+ #:use-module ((guix build syscalls)
+ #:select (with-file-lock/no-wait))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@@ -876,36 +878,45 @@ processed, #f otherwise."
(package-version item)
(manifest-entry-version entry))))))
- ;; First, process roll-backs, generation removals, etc.
- (for-each (match-lambda
- ((key . arg)
- (and=> (assoc-ref %actions key)
- (lambda (proc)
- (proc store profile arg opts
- #:dry-run? dry-run?)))))
- opts)
- ;; Then, process normal package removal/installation/upgrade.
- (let* ((manifest (profile-manifest profile))
- (step1 (options->removable opts manifest
- (manifest-transaction)))
- (step2 (options->installable opts manifest step1))
- (step3 (manifest-transaction
- (inherit step2)
- (install (map transform-entry
- (manifest-transaction-install step2)))))
- (new (manifest-perform-transaction manifest step3)))
+ ;; 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 guix process.~%")
+ profile))
- (warn-about-old-distro)
+ ;; Then, process roll-backs, generation removals, etc.
+ (for-each (match-lambda
+ ((key . arg)
+ (and=> (assoc-ref %actions key)
+ (lambda (proc)
+ (proc store profile arg opts
+ #:dry-run? dry-run?)))))
+ opts)
- (unless (manifest-transaction-null? step3)
- (show-manifest-transaction store manifest step3
- #:dry-run? dry-run?)
- (build-and-use-profile store profile new
- #:allow-collisions? allow-collisions?
- #:bootstrap? bootstrap?
- #:use-substitutes? substitutes?
- #:dry-run? dry-run?))))
+ ;; Then, process normal package removal/installation/upgrade.
+ (let* ((manifest (profile-manifest profile))
+ (step1 (options->removable opts manifest
+ (manifest-transaction)))
+ (step2 (options->installable opts manifest step1))
+ (step3 (manifest-transaction
+ (inherit step2)
+ (install (map transform-entry
+ (manifest-transaction-install step2)))))
+ (new (manifest-perform-transaction manifest step3)))
+
+ (warn-about-old-distro)
+
+ (unless (manifest-transaction-null? step3)
+ (show-manifest-transaction store manifest step3
+ #:dry-run? dry-run?)
+ (build-and-use-profile store profile new
+ #:allow-collisions? allow-collisions?
+ #:bootstrap? bootstrap?
+ #:use-substitutes? substitutes?
+ #:dry-run? dry-run?)))))
\f
;;;
--
2.22.0
next prev parent reply other threads:[~2019-10-25 22:09 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-06-25 14:10 bug#36375: ‘guix package’ should lock the profile Ludovic Courtès
2019-10-25 19:44 ` bug#36375: [PATCH] " Julien Lepiller
2019-10-25 21:21 ` Ludovic Courtès
2019-10-25 22:08 ` Julien Lepiller [this message]
2019-11-06 13:24 ` Ludovic Courtès
2019-11-07 21:19 ` Julien Lepiller
2019-11-08 20:03 ` Ludovic Courtès
2019-11-08 21:03 ` Julien Lepiller
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20191026000806.7eb6342b@sybil.lepiller.eu \
--to=julien@lepiller.eu \
--cc=36375@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.