From 06b9c1260c72935806957bf302c40c1db6101a63 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 2 Dec 2023 12:04:23 +0100
Subject: [PATCH] substitute: Do not exit when failing to find a nar.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes <https://issues.guix.gnu.org/67575>.

* guix/scripts/substitute.scm (process-substitution/fallback): Use
‘report-error’ instead of ‘leave’.  Write status line to PORT.
* tests/substitute.scm ("substitute, narinfo is available but nar is
missing"): Adjust accordingly.

Change-Id: Ic7297dbd563c007111ec2167c8d52505a07d4822
---
 guix/scripts/substitute.scm |  5 +++--
 tests/substitute.scm        | 45 ++++++++++++++++++++-----------------
 2 files changed, 27 insertions(+), 23 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 126f0f9c69..37cd08e289 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -635,8 +635,9 @@ (define* (process-substitution/fallback port narinfo destination
   (let loop ((cache-urls cache-urls))
     (match cache-urls
       (()
-       (leave (G_ "failed to find alternative substitute for '~a'~%")
-              (narinfo-path narinfo)))
+       (report-error (G_ "failed to find alternative substitute for '~a'~%")
+                     (narinfo-path narinfo))
+       (display "not-found\n" port))
       ((cache-url rest ...)
        (match (lookup-narinfos cache-url
                                (list (narinfo-path narinfo))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 7246ed82d5..33a6d6040a 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -662,28 +662,31 @@ (define-syntax-rule (with-narinfo* narinfo directory body ...)
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
 
-(test-quit "substitute, narinfo is available but nar is missing"
-    "failed to find alternative substitute"
-  (with-narinfo*
-      (string-append %narinfo "Signature: "
-                     (signature-field
-                      %narinfo
-                      #:public-key %wrong-public-key))
-      %main-substitute-directory
+(test-equal "substitute, narinfo is available but nar is missing"
+  "not-found\n"
+  (let ((port (open-output-string)))
+    (parameterize ((current-output-port port))
+      (with-narinfo*
+          (string-append %narinfo "Signature: "
+                         (signature-field
+                          %narinfo
+                          #:public-key %wrong-public-key))
+          %main-substitute-directory
 
-    (with-http-server `((200 ,(string-append %narinfo "Signature: "
-                                             (signature-field %narinfo)))
-                        (404 "Sorry, nar is missing!"))
-      (parameterize ((substitute-urls
-                      (list (%local-url)
-                            (string-append "file://"
-                                           %main-substitute-directory))))
-        (delete-file (string-append %main-substitute-directory
-                                    "/example.nar"))
-        (request-substitution (string-append (%store-prefix)
-                                             "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
-                              "substitute-retrieved")
-        (not (file-exists? "substitute-retrieved"))))))
+        (with-http-server `((200 ,(string-append %narinfo "Signature: "
+                                                 (signature-field %narinfo)))
+                            (404 "Sorry, nar is missing!"))
+          (parameterize ((substitute-urls
+                          (list (%local-url)
+                                (string-append "file://"
+                                               %main-substitute-directory))))
+            (delete-file (string-append %main-substitute-directory
+                                        "/example.nar"))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved")
+            (and (not (file-exists? "substitute-retrieved"))
+                 (get-output-string port))))))))
 
 (test-equal "substitute, first narinfo is unsigned and has wrong hash"
   "Substitutable data."