aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-08-20 13:09:56 +0100
committerChristopher Baines <mail@cbaines.net>2023-08-20 13:09:56 +0100
commitc4008265d4f19adad8827f454556ab0e66075e7d (patch)
treeea6d09ca3952f3f47501d3be6549bb7340c46b8c
parent1727f4f1be2ad2cd8a6fc3dd19804b8072ca3f8b (diff)
downloadbuild-coordinator-c4008265d4f19adad8827f454556ab0e66075e7d.tar
build-coordinator-c4008265d4f19adad8827f454556ab0e66075e7d.tar.gz
Pass the store in to substitute-derivation
To avoid an additional store connection.
-rw-r--r--guix-build-coordinator/agent.scm3
-rw-r--r--guix-build-coordinator/client-communication.scm9
-rw-r--r--guix-build-coordinator/hooks.scm5
-rw-r--r--guix-build-coordinator/utils.scm50
4 files changed, 35 insertions, 32 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 5eeacdc..200a343 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -878,7 +878,8 @@ but the guix-daemon claims it's unavailable"
build-id ": substituting derivation")
(retry-on-error
(lambda ()
- (substitute-derivation derivation-name
+ (substitute-derivation store
+ derivation-name
#:substitute-urls
derivation-substitute-urls)
(add-temp-root store derivation-name))
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 05e9695..f1d0208 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -438,10 +438,11 @@
derivation))))
(define (read-drv/substitute derivation-file)
- (unless (with-store store
- (valid-path? store derivation-file))
- (substitute-derivation derivation-file
- #:substitute-urls substitute-urls))
+ (with-store/non-blocking store
+ (unless (valid-path? store derivation-file)
+ (substitute-derivation store
+ derivation-file
+ #:substitute-urls substitute-urls)))
(read-derivation-from-file* derivation-file))
(let ((submit-build-result
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index a0ae0c1..a98f318 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -134,10 +134,9 @@
'()
(with-store store
(unless (valid-path? store drv-name)
- (set-store-connection-timeout store #:timeout 20)
-
;; TODO This isn't ideal as it can be blocked by GC
- (substitute-derivation drv-name
+ (substitute-derivation store
+ drv-name
#:substitute-urls
derivation-substitute-urls)
(add-temp-root store drv-name))
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 69d5167..9aee736 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -68,6 +68,8 @@
read-derivation-from-file*
+ with-store/non-blocking
+
substitute-derivation
read-derivation-through-substitutes
@@ -429,32 +431,32 @@ context."
(let ()
exp ...)))
-(define* (substitute-derivation derivation-name
+(define* (substitute-derivation store
+ derivation-name
#:key substitute-urls)
(let ((log-port (open-output-string)))
- (with-store/non-blocking store
- (apply set-build-options
- store
- `(,@(if substitute-urls
- `(#:substitute-urls ,substitute-urls)
- '())
- #:max-silent-time 60
- #:timeout ,(* 10 60)))
-
- (with-exception-handler
- (lambda (exn)
- (let ((log-string
- (get-output-string log-port)))
- (close-output-port log-port)
- (simple-format
- (current-error-port)
- "exception when substituting derivation: ~A:\n ~A\n"
- exn log-string)
- (raise-exception exn)))
- (lambda ()
- (parameterize ((current-build-output-port log-port))
- (ensure-path store derivation-name)))
- #:unwind? #t))))
+ (apply set-build-options
+ store
+ `(,@(if substitute-urls
+ `(#:substitute-urls ,substitute-urls)
+ '())
+ #:max-silent-time 60
+ #:timeout ,(* 10 60)))
+
+ (with-exception-handler
+ (lambda (exn)
+ (let ((log-string
+ (get-output-string log-port)))
+ (close-output-port log-port)
+ (simple-format
+ (current-error-port)
+ "exception when substituting derivation: ~A:\n ~A\n"
+ exn log-string)
+ (raise-exception exn)))
+ (lambda ()
+ (parameterize ((current-build-output-port log-port))
+ (ensure-path store derivation-name)))
+ #:unwind? #t)))
(define read-derivation-from-file*
(let ((%derivation-cache