109/184: guix: package: lock profiles when processing them.

[guix-commits]

kkebreau pushed a commit to branch wip-gnome-updates
in repository guix.

commit d9c8660df6f8837ed14fa6406e23694fbca07b3e
Author: Julien Lepiller <address@hidden>
Date:   Fri Oct 25 21:39:21 2019 +0200

    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 | 70 +++++++++++++++++++++++++++---------------------
 tests/guix-package.sh    | 10 ++++++-
 2 files changed, 49 insertions(+), 31 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1a58d43..bcd03a1 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)))
-
-    (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?))))
+
+  ;; 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))
+
+    ;; 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)
+
+    ;; 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 0de30bf..7ad0699 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