bug#36375: ‘guix package’ should lock the profile

bug#36375: ‘guix package’ should lock the profile

[Ludovic Courtès]

The article at
<https://distrowatch.com/weekly.php?issue=20190624#guixsd> mentions
things like:

  For instance, after installing Icecat, I installed a few other desktop
  programs and then found Icecat had disappeared from my path again.

It’s likely that the person ran several ‘guix package’ commands in
parallel, and that one undoed the effects of the other.

Julien suggested that ‘guix package’ could grab a lock file, and I guess
it could simply error out when the lock is already taken.

Ludo’.

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Julien Lepiller]

[-- Attachment #1: Type: text/plain, Size: 876 bytes --]

Le Tue, 25 Jun 2019 16:10:22 +0200,
Ludovic Courtès <ludo@gnu.org> a écrit :

> The article at
> <https://distrowatch.com/weekly.php?issue=20190624#guixsd> mentions
> things like:
> 
>   For instance, after installing Icecat, I installed a few other
> desktop programs and then found Icecat had disappeared from my path
> again.
> 
> It’s likely that the person ran several ‘guix package’ commands in
> parallel, and that one undoed the effects of the other.
> 
> Julien suggested that ‘guix package’ could grab a lock file, and I
> guess it could simply error out when the lock is already taken.
> 
> Ludo’.

Hi!

attached is a patch for guix package to grab a lock file. Note that I'm
using flock, so it won't work on NFS shares. The other option would be
to use fcntl but guile doesn't seem to implement the locking function
from it.

[-- Attachment #2: 0001-guix-package-lock-profiles-when-processing-them.patch --]
[-- Type: text/x-patch, Size: 1790 bytes --]

From 987e9711f1fa6bfd270e48ee5624f69696e7e5c4 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/scripts/package.scm | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1a58d43e5c..e4f0f416f5 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -876,7 +876,17 @@ processed, #f otherwise."
                      (package-version item)
                      (manifest-entry-version entry))))))
 
-  ;; First, process roll-backs, generation removals, etc.
+  ;; First, acquire a lock on the profile, to ensure only one guix process
+  ;; is modifying it at a time.
+  (define lock-file (open (string-append profile ".lock") O_CREAT))
+  (catch 'system-error
+    (lambda _
+      (flock lock-file (logior LOCK_EX LOCK_NB)))
+    (lambda (key . args)
+      (leave (G_ "profile ~a is being locked by another guix process.~%")
+                 profile)))
+
+  ;; Then, process roll-backs, generation removals, etc.
   (for-each (match-lambda
               ((key . arg)
                (and=> (assoc-ref %actions key)
@@ -905,7 +915,10 @@ processed, #f otherwise."
                              #:allow-collisions? allow-collisions?
                              #:bootstrap? bootstrap?
                              #:use-substitutes? substitutes?
-                             #:dry-run? dry-run?))))
+                             #:dry-run? dry-run?)))
+
+  ;; Finaly, close the lock file
+  (close lock-file))
 
 \f
 ;;;
-- 
2.22.0

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Ludovic Courtès]

Hello,

Julien Lepiller <julien@lepiller.eu> skribis:

> attached is a patch for guix package to grab a lock file. Note that I'm
> using flock, so it won't work on NFS shares. The other option would be
> to use fcntl but guile doesn't seem to implement the locking function
> from it.

(guix build syscalls) has it though, so you should probably use it.  :-)

> From 987e9711f1fa6bfd270e48ee5624f69696e7e5c4 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.

[...]

> -  ;; First, process roll-backs, generation removals, etc.
> +  ;; First, acquire a lock on the profile, to ensure only one guix process
> +  ;; is modifying it at a time.
> +  (define lock-file (open (string-append profile ".lock") O_CREAT))
> +  (catch 'system-error
> +    (lambda _
> +      (flock lock-file (logior LOCK_EX LOCK_NB)))
> +    (lambda (key . args)
> +      (leave (G_ "profile ~a is being locked by another guix process.~%")
> +                 profile)))

Nitpick: "profile ~a is locked by another process~%".

> +  ;; Then, process roll-backs, generation removals, etc.
>    (for-each (match-lambda
>                ((key . arg)
>                 (and=> (assoc-ref %actions key)
> @@ -905,7 +915,10 @@ processed, #f otherwise."
>                               #:allow-collisions? allow-collisions?
>                               #:bootstrap? bootstrap?
>                               #:use-substitutes? substitutes?
> -                             #:dry-run? dry-run?))))
> +                             #:dry-run? dry-run?)))
> +
> +  ;; Finaly, close the lock file
> +  (close lock-file))

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’.

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Julien Lepiller]

[-- 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

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Ludovic Courtès]

Hello!

Julien Lepiller <julien@lepiller.eu> skribis:

>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.

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’.

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Julien Lepiller]

[-- Attachment #1: Type: text/plain, Size: 3005 bytes --]

Le Wed, 06 Nov 2019 14:24:54 +0100,
Ludovic Courtès <ludo@gnu.org> a écrit :

> Hello!
> 
> Julien Lepiller <julien@lepiller.eu> skribis:
> 
> >>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.  
> 
> 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.

[-- Attachment #2: 0001-guix-Add-file-locking-with-no-wait.patch --]
[-- Type: text/x-patch, Size: 2810 bytes --]

From 71a85b5a8aac6c0bd5a1a4e3b52e409b2112df7a Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@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))
+
 \f
 ;;;
 ;;; Miscellaneous, aka. 'prctl'.
-- 
2.22.0


[-- Attachment #3: 0002-guix-package-lock-profiles-when-processing-them.patch --]
[-- Type: text/x-patch, Size: 5322 bytes --]

From 50c792e155d1207127f10ff0c0360442b7736a64 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@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?)))))
 
 \f
 ;;;
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

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Ludovic Courtès]

Hello!

Julien Lepiller <julien@lepiller.eu> skribis:

> From 71a85b5a8aac6c0bd5a1a4e3b52e409b2112df7a Mon Sep 17 00:00:00 2001
> From: Julien Lepiller <julien@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.

[...]

> From 50c792e155d1207127f10ff0c0360442b7736a64 Mon Sep 17 00:00:00 2001
> From: Julien Lepiller <julien@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.

LGTM!

I tested ‘with-file-lock’ on an NFSv3 mount, and ‘F_SETLKW’ is correctly
implemented, FWIW.

Thank you!

Ludo’.

bug#36375: [PATCH] Re: ‘guix package’ should lock the profile

[Julien Lepiller]

Le Fri, 08 Nov 2019 21:03:05 +0100,
Ludovic Courtès <ludo@gnu.org> a écrit :

> Hello!
> 
> Julien Lepiller <julien@lepiller.eu> skribis:
> 
> > From 71a85b5a8aac6c0bd5a1a4e3b52e409b2112df7a Mon Sep 17 00:00:00
> > 2001 From: Julien Lepiller <julien@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.  
> 
> [...]
> 
> > From 50c792e155d1207127f10ff0c0360442b7736a64 Mon Sep 17 00:00:00
> > 2001 From: Julien Lepiller <julien@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.  
> 
> LGTM!
> 
> I tested ‘with-file-lock’ on an NFSv3 mount, and ‘F_SETLKW’ is
> correctly implemented, FWIW.
> 
> Thank you!
> 
> Ludo’.

Pushed as f49e9131889775a74a85c1f9b29f108030337b8b and
b1fb663404894268b5ee92c040f12c52c0bee425.