02/17: substitute: Do not exit when failing to find a nar.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 06b9c1260c72935806957bf302c40c1db6101a63
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Dec 2 12:04:23 2023 +0100

    substitute: Do not exit when failing to find a nar.
    
    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        | 47 ++++++++++++++++++++++++---------------------
 2 files changed, 28 insertions(+), 24 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 @@ way to download the nar."
   (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 @@ System: mips64el-linux\n")))
         (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
-
-    (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"))))))
+(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")
+            (and (not (file-exists? "substitute-retrieved"))
+                 (get-output-string port))))))))
 
 (test-equal "substitute, first narinfo is unsigned and has wrong hash"
   "Substitutable data."