Le Wed, 06 Nov 2019 14:24:54 +0100,
Ludovic Courtès <l...@gnu.org> a écrit :
> Hello!
>
> Julien Lepiller <jul...@lepiller.eu> skribis:
>
> >>From 5d86226f318a111cc1bdf5a6f044c6f540f51b45 Mon Sep 17 00:00:00
> >>2001
> > From: Julien Lepiller <jul...@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.
>
> Nice! Could you make the syscalls.scm changes a separate patch?
>
> > +(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))
>
> Please remove tabs. :-)
>
> This is wrong because (1) ‘args’ is always a list, and (2) ‘=’ is
> defined for numbers, not for symbols and lists.
>
> I think you actually want to catch two exceptions here: ‘system-error’
> and ‘flock-error’. For that, you have to do:
>
> (catch #t
> (lambda ()
> (lock-file …))
> (lambda (key . args)
> (match key
> ('flock-error …)
> ('system-error
> (if (= ENOSYS (system-error-errno (cons key args)))
> …))
> (_
> (apply throw key args)))))
>
> Does that make sense?
>
> > + ;; 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")
>
> Nitpick: I’d move the lock file name on the same line as
> ‘with-file-lock/no-wait’.
>
> > + (lambda (key . args)
> > + (leave (G_ "profile ~a is locked by another guix process.~%")
> > + profile))
>
> s/guix// and remove the trailing period.
>
> Could you add a test for that in tests/guix-package.sh?
>
> One way to do it may be to do something like:
>
> echo '(sleep 60) > /…/manifest.scm
> guix package -m /…/manifest.scm -p whatever &
> pid=$!
> if guix install emacs -p whatever; then false; else true; fi
> kill $pid
>
> Could you send updated patches?
>
> Thanks!
>
> Ludo’.
Attached are updated patches! I also made sure the new test passes.
>From 71a85b5a8aac6c0bd5a1a4e3b52e409b2112df7a Mon Sep 17 00:00:00 2001
From: Julien Lepiller <jul...@lepiller.eu>
Date: Thu, 7 Nov 2019 21:50:54 +0100
Subject: [PATCH 1/2] guix: Add file-locking with no wait.
* guix/build/syscalls.scm (with-file-lock/no-wait): New procedure.
(lock-file): Take a #:wait? key.
---
guix/build/syscalls.scm | 35 +++++++++++++++++++++++++++++++++--
1 file changed, 33 insertions(+), 2 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index bbf2531c79..a5a9c92a42 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,40 @@ exception if it's already taken."
(when port
(unlock-file port))))))
+(define (call-with-file-lock/no-wait file thunk handler)
+ (let ((port (catch #t
+ (lambda ()
+ (lock-file file #:wait? #f))
+ (lambda (key . args)
+ (match key
+ ('flock-error
+ (handler args))
+ ('system-error
+ ;; 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 (= ENOSYS (system-error-errno (cons key args)))
+ #f
+ (apply throw args)))
+ (_ (apply throw key 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))
+
;;;
;;; Miscellaneous, aka. 'prctl'.
--
2.22.0
>From 50c792e155d1207127f10ff0c0360442b7736a64 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <jul...@lepiller.eu>
Date: Fri, 25 Oct 2019 21:39:21 +0200
Subject: [PATCH 2/2] guix: package: lock profiles when processing them.
* guix/scripts/package.scm (process-actions): Get a per-profile lock to
prevent concurrent actions on profiles.
* tests/guix-package.sh: Add test.
---
guix/scripts/package.scm | 64 +++++++++++++++++++++++-----------------
tests/guix-package.sh | 10 ++++++-
2 files changed, 46 insertions(+), 28 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1a58d43e5c..bcd03a1df9 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,44 @@ 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 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?)))))
;;;
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 0de30bf6c1..7ad0699380 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -33,7 +33,7 @@ profile="t-profile-$$"
tmpfile="t-guix-package-file-$$"
rm -f "$profile" "$tmpfile"
-trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT
+trap 'rm -f "$profile" "$profile.lock" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT
# Use `-e' with a non-package expression.
if guix package --bootstrap -e +;
@@ -452,3 +452,11 @@ rm -rf "$module_dir"
# Make sure we can see user profiles.
guix package --list-profiles | grep "$profile"
guix package --list-profiles | grep '\.guix-profile'
+
+# Make sure we can properly lock a profile.
+mkdir "$module_dir"
+echo '(sleep 60)' > "$module_dir/manifest.scm"
+guix package -m "$module_dir/manifest.scm" -p "$module_dir/profile" &
+pid=$!
+if guix install emacs -p "$module_dir/profile"; then kill $pid; false; else true; fi
+kill $pid
--
2.22.0
