Subject: [bug#38649] [PATCH] Parallelize `guix package`

From: Leo Prikler <[email-masked]>
Date: Tue, 17 Dec 2019 15:18:44 +0100

Hi Guix!

Yesterday I had an interesting conversation on IRC about the behaviour
of multiple `guix package` processes running in parallel. 
Specifically, when two transactions target the same profile (usually
/var/guix/profiles/per-user/$USER/guix-profile) at the same time, one
of them will fail to claim the lock and abort.  0001 makes it so that
the process waits for the lock.  0002 makes it so that packages
specified via -i can be built in parallel.

Regards,
Leo
From f990fee25e4d62ffff4d6ee89be05b2563865324 Mon Sep 17 00:00:00 2001
From: Leo Prikler <[email-masked]>
Date: Tue, 17 Dec 2019 12:53:21 +0100
Subject: [PATCH 1/2] guix: Wait for file lock.

* guix/ui.scm: Adjust imports.
(with-profile-lock): Use `with-file-lock' instead of `with-file-lock/no-wait'.
* guix/scripts/package.scm: Drop unused import.
(process-actions): Print message while waiting on lock.
---
 guix/scripts/package.scm | 3 +--
 guix/ui.scm              | 4 ++--
 2 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 92c6e34194..202a6d6470 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -42,8 +42,6 @@
   #: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)
@@ -866,6 +864,7 @@ processed, #f otherwise."
 
   ;; First, acquire a lock on the profile, to ensure only one guix process
   ;; is modifying it at a time.
+  (format #t "Waiting for lock on ~a...~%" profile)
   (with-profile-lock profile
     ;; Then, process roll-backs, generation removals, etc.
     (for-each (match-lambda
diff --git a/guix/ui.scm b/guix/ui.scm
index 540671f3dd..060c4e73f1 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -48,7 +48,7 @@
                 #:select (license? license-name license-uri))
   #:use-module ((guix build syscalls)
                 #:select (free-disk-space terminal-columns terminal-rows
-                          with-file-lock/no-wait))
+                          with-file-lock))
   #:use-module ((guix build utils)
                 ;; XXX: All we need are the bindings related to
                 ;; '&invoke-error'.  However, to work around the bug described
@@ -1680,7 +1680,7 @@ DURATION-RELATION with the current time."
 (define-syntax-rule (with-profile-lock profile exp ...)
   "Grab PROFILE's lock and evaluate EXP...  Call 'leave' if the lock is
 already taken."
-  (with-file-lock/no-wait (profile-lock-file profile)
+  (with-file-lock (profile-lock-file profile)
     (cut profile-lock-handler profile <...>)
     exp ...))
 
-- 
2.24.1

From 336692df15e77f9d90619d0fe60e864c4d2fb37a Mon Sep 17 00:00:00 2001
From: Leo Prikler <[email-masked]>
Date: Tue, 17 Dec 2019 14:04:12 +0100
Subject: [PATCH 2/2] guix: Build to be installed packages in parallel.

* guix/scripts/package.scm (options->buildable): New procedure.
(process-actions): Build packages before acquiring profile lock.
---
 guix/scripts/package.scm | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 202a6d6470..1278d1a65f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -587,6 +587,19 @@ the resulting manifest entry."
   (package->manifest-entry package output
                            #:properties (provenance-properties package)))
 
+(define (options->buildable opts)
+  (filter-map (match-lambda
+                (('install . (? package? p))
+                 p)
+                (('install . (? string? spec))
+                 (if (store-path? spec)
+                     #f ;; assume already interned
+                     (specification->package spec)))
+                (('install . obj)
+                 (leave (G_ "cannot build non-package object: ~s~%")
+                        obj))
+                (_ #f))
+              opts))
 
 (define (options->installable opts manifest transaction)
   "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
@@ -861,8 +874,15 @@ processed, #f otherwise."
                      (package-version item)
                      (manifest-entry-version entry))))))
 
+  ;; First, process installations, as these can be handled in parallel.
+  (unless dry-run?
+    (let* ((drv (map (compose (lambda (drv) (drv store)) package->derivation)
+                     (options->buildable opts))))
+      (show-what-to-build store drv
+                          #:use-substitutes? substitutes?)
+      (build-derivations store drv)))
 
-  ;; First, acquire a lock on the profile, to ensure only one guix process
+  ;; Now, acquire a lock on the profile, to ensure only one guix process
   ;; is modifying it at a time.
   (format #t "Waiting for lock on ~a...~%" profile)
   (with-profile-lock profile
-- 
2.24.1