summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-05-22 17:19:39 +0200
committerLudovic Courtès <ludo@gnu.org>2023-05-30 00:15:29 +0200
commit8af9a2aa5fa2fa5b00234c1cbe12e9aff60888a0 (patch)
treedfba35bca4c132a0bccd71cd7ef85369e116e819 /tests
parentd23d8fcee99e7b127f9e649925caca9cf0d36e76 (diff)
downloadguix-8af9a2aa5fa2fa5b00234c1cbe12e9aff60888a0.tar.gz
substitute: If a server's nar URL is 404, try the next one(s).
If a substitute server advertises in its narinfo, for example, both a
/zstd and a /lzip URL but the /zstd URL is unreachable, try the /lzip
URL.

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

* guix/narinfo.scm (narinfo-preferred-uris): New procedure.
(narinfo-best-uri): Rebase on top of it.
* guix/scripts/substitute.scm (download-nar)[try-fetch]: New procedure.
Use 'narinfo-preferred-uris' and 'try-fetch' to attempt all the URLs of
NARINFO.
* tests/substitute.scm (request-substitution): Remove 'parameterize'.
Delete DESTINATION.
("substitute, preferred nar URL is 404, other is 200"): New test.
Diffstat (limited to 'tests')
-rw-r--r--tests/substitute.scm36
1 files changed, 31 insertions, 5 deletions
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 9032a50268..8df3938b59 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -64,11 +64,11 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
 
 (define (request-substitution item destination)
   "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
-  (parameterize ((guix-warning-port (current-error-port)))
-    (with-input-from-string (string-append "substitute " item " "
-                                           destination "\n")
-      (lambda ()
-        (guix-substitute "--substitute")))))
+  (false-if-exception (delete-file destination))
+  (with-input-from-string (string-append "substitute " item " "
+                                         destination "\n")
+    (lambda ()
+      (guix-substitute "--substitute"))))
 
 (define %public-key
   ;; This key is known to be in the ACL by default.
@@ -613,6 +613,32 @@ System: mips64el-linux\n")))
                 (lambda ()
                   (false-if-exception (delete-file "substitute-retrieved")))))))))))
 
+(test-equal "substitute, preferred nar URL is 404, other is 200"
+  "Substitutable data."
+  (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo))
+      %main-substitute-directory
+
+    (with-http-server `((200 ,(string-append %narinfo "Signature: "
+                                             (signature-field %narinfo)
+                                             "\n"
+                                             "URL: example.nar.lz\n"
+                                             "Compression: lzip\n"))
+                        (404 "Sorry, nar.lz is missing!")
+                        (200 ,(call-with-input-file
+                                  (string-append %main-substitute-directory
+                                                 "/example.nar")
+                                get-bytevector-all)))
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (parameterize ((substitute-urls (list (%local-url))))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
+          (call-with-input-file "substitute-retrieved" get-string-all))
+        (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*