1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

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.
This commit is contained in:
Ludovic Courtès
2023-05-22 17:19:39 +02:00
parent d23d8fcee9
commit 8af9a2aa5f
3 changed files with 70 additions and 20 deletions

View File

@@ -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*