From bea5bf2c03edca99e63ae9a2ff1e865e60a11ca7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 10 Aug 2023 07:47:10 +0100
Subject: Simplify substitute-derivation

Assume ensure-path is available.
---
 guix-build-coordinator/utils.scm | 77 ++++++++++++----------------------------
 1 file changed, 23 insertions(+), 54 deletions(-)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index a91e771..8926fa8 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -432,60 +432,29 @@ context."
 (define* (substitute-derivation derivation-name
                                 #:key substitute-urls)
   (let ((log-port (open-output-string)))
-    (catch #t
-      (lambda ()
-        (if (defined? 'ensure-path
-              (resolve-module '(guix store)))
-            (with-store/non-blocking store
-              (apply set-build-options
-                     store
-                     `(,@(if substitute-urls
-                             `(#:substitute-urls ,substitute-urls)
-                             '())
-                       #:max-silent-time 60
-                       #:timeout ,(* 10 60)))
-
-              (parameterize ((current-build-output-port log-port))
-                (with-port-timeouts
-                 (lambda ()
-                   (set-store-connection-timeout store)
-                   (ensure-path store derivation-name))
-                 #:timeout (* 120 1000))))
-            (with-store/non-blocking store
-              (apply set-build-options
-                     store
-                     `(#:print-extended-build-trace? #t
-                       #:multiplexed-build-output? #t
-                       ,@(if substitute-urls
-                             `(#:substitute-urls ,substitute-urls)
-                             '())))
-
-              (with-status-report
-                  (lambda (event status new)
-                    (print-build-event event status new)
-                    (match event
-                      (('substituter-succeeded substituted-drv)
-                       (when (string=? derivation-name
-                                       substituted-drv)
-                         (close-connection store)))
-                      (_ #t)))
-                (build-things store (list derivation-name))))))
-      (lambda (key . args)
-        (let ((log-string
-               (get-output-string log-port)))
-          (close-output-port log-port)
-          ;; This is a hack, to ignore errors relating to closing the store
-          ;; connection.
-          (if (with-store/non-blocking store
-                (valid-path? store derivation-name))
-              #t
-              (begin
-                (simple-format
-                 (current-error-port)
-                 "exception when substituting derivation: ~A ~A:\n  ~A\n"
-                 key args log-string)
-                (error (simple-format #f "could not substitute ~A\n"
-                                      derivation-name)))))))))
+    (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))))
 
 (define read-derivation-from-file*
   (let ((%derivation-cache
-- 
cgit v1.2.3