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: Sat, 26 Oct 2019 00:08:06 +0200 Message-ID: <20191026000806.7eb6342b@sybil.lepiller.eu> References: <875zotn4c1.fsf@gnu.org> <20191025214451.284c3530@sybil.lepiller.eu> <87tv7wldwh.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/60YbQDeCEhoBxDR8CJlH1yb" Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:44314) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iO7lX-0007XO-Ks for bug-guix@gnu.org; Fri, 25 Oct 2019 18:09:05 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iO7lW-0005Sz-50 for bug-guix@gnu.org; Fri, 25 Oct 2019 18:09:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:58929) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iO7lW-0005Sn-1K for bug-guix@gnu.org; Fri, 25 Oct 2019 18:09:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iO7lV-0006Cg-Q6 for bug-guix@gnu.org; Fri, 25 Oct 2019 18:09:01 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <87tv7wldwh.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_/60YbQDeCEhoBxDR8CJlH1yb Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Le Fri, 25 Oct 2019 23:21:34 +0200, Ludovic Court=C3=A8s a =C3=A9crit : >=20 > I=E2=80=99d recommend wrapping the body in =E2=80=98with-file-lock=E2=80= =99 (from (guix build > syscalls)), which handles non-local exits. >=20 > However you=E2=80=99d first need to add a #:wait? argument to =E2=80=98wi= th-file-lock=E2=80=99 > and perhaps an additional argument to handle the already-locked case. > Or maybe call that =E2=80=98with-file-lock/no-wait=E2=80=99. >=20 > How does that sound? >=20 > Thanks for working on it! >=20 > Ludo=E2=80=99. Thanks! here is a new patch with your suggestions. --MP_/60YbQDeCEhoBxDR8CJlH1yb Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=0001-guix-package-lock-profiles-when-processing-them.patch >From 5d86226f318a111cc1bdf5a6f044c6f540f51b45 Mon Sep 17 00:00:00 2001 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. --- 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)) + ;;; ;;; 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?))))) ;;; -- 2.22.0 --MP_/60YbQDeCEhoBxDR8CJlH1yb--