From mboxrd@z Thu Jan 1 00:00:00 1970 From: Julien Lepiller Subject: bug#36375: [PATCH] Re: =?UTF-8?Q?=E2=80=98guix_?= =?UTF-8?Q?package=E2=80=99?= should lock the profile Date: Thu, 7 Nov 2019 22:19:36 +0100 Message-ID: <20191107221936.1ff9bed6@sybil.lepiller.eu> References: <875zotn4c1.fsf@gnu.org> <20191025214451.284c3530@sybil.lepiller.eu> <87tv7wldwh.fsf@gnu.org> <20191026000806.7eb6342b@sybil.lepiller.eu> <87mud95e8p.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/54Pg=3SZ85vyjmuXtm1k9n+" Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:43355) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iSpCG-00010z-Gs for bug-guix@gnu.org; Thu, 07 Nov 2019 16:20:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iSpCE-0006KN-G9 for bug-guix@gnu.org; Thu, 07 Nov 2019 16:20:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:35200) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iSpCE-0006Jg-6p for bug-guix@gnu.org; Thu, 07 Nov 2019 16:20:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iSpCD-0003AB-TO for bug-guix@gnu.org; Thu, 07 Nov 2019 16:20:01 -0500 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <87mud95e8p.fsf@gnu.org> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 36375@debbugs.gnu.org --MP_/54Pg=3SZ85vyjmuXtm1k9n+ Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Le Wed, 06 Nov 2019 14:24:54 +0100, Ludovic Court=C3=A8s a =C3=A9crit : > Hello! >=20 > Julien Lepiller skribis: >=20 > >>From 5d86226f318a111cc1bdf5a6f044c6f540f51b45 Mon Sep 17 00:00:00 > >>2001 =20 > > From: Julien Lepiller > > 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. =20 >=20 > Nice! Could you make the syscalls.scm changes a separate patch? >=20 > > +(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 (=3D ENOSYS (system-error-errno args)) (=3D > > 'flock-error args)) =20 >=20 > Please remove tabs. :-) >=20 > This is wrong because (1) =E2=80=98args=E2=80=99 is always a list, and (2= ) =E2=80=98=3D=E2=80=99 is > defined for numbers, not for symbols and lists. >=20 > I think you actually want to catch two exceptions here: =E2=80=98system-e= rror=E2=80=99 > and =E2=80=98flock-error=E2=80=99. For that, you have to do: >=20 > (catch #t > (lambda () > (lock-file =E2=80=A6)) > (lambda (key . args) > (match key > ('flock-error =E2=80=A6) > ('system-error > (if (=3D ENOSYS (system-error-errno (cons key args))) > =E2=80=A6)) > (_ > (apply throw key args))))) > =20 > Does that make sense? >=20 > > + ;; 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") =20 >=20 > Nitpick: I=E2=80=99d move the lock file name on the same line as > =E2=80=98with-file-lock/no-wait=E2=80=99. >=20 > > + (lambda (key . args) > > + (leave (G_ "profile ~a is locked by another guix process.~%") > > + profile)) =20 >=20 > s/guix// and remove the trailing period. >=20 > Could you add a test for that in tests/guix-package.sh? >=20 > One way to do it may be to do something like: >=20 > echo '(sleep 60) > /=E2=80=A6/manifest.scm > guix package -m /=E2=80=A6/manifest.scm -p whatever & > pid=3D$! > if guix install emacs -p whatever; then false; else true; fi > kill $pid >=20 > Could you send updated patches? >=20 > Thanks! >=20 > Ludo=E2=80=99. Attached are updated patches! I also made sure the new test passes. --MP_/54Pg=3SZ85vyjmuXtm1k9n+ Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=0001-guix-Add-file-locking-with-no-wait.patch >From 71a85b5a8aac6c0bd5a1a4e3b52e409b2112df7a Mon Sep 17 00:00:00 2001 From: Julien Lepiller 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 --MP_/54Pg=3SZ85vyjmuXtm1k9n+ Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=0002-guix-package-lock-profiles-when-processing-them.patch >From 50c792e155d1207127f10ff0c0360442b7736a64 Mon Sep 17 00:00:00 2001 From: Julien Lepiller 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 --MP_/54Pg=3SZ85vyjmuXtm1k9n+--