summaryrefslogtreecommitdiff
path: root/guix/scripts
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 /guix/scripts
parentd23d8fcee99e7b127f9e649925caca9cf0d36e76 (diff)
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 'guix/scripts')
-rwxr-xr-xguix/scripts/substitute.scm35
1 files changed, 23 insertions, 12 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0b27ebb0fc..3626832dda 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -481,18 +481,29 @@ STATUS-PORT."
(leave (G_ "unsupported substitute URI scheme: ~a~%")
(uri->string uri)))))
- (let ((uri compression file-size
- (narinfo-best-uri narinfo
- #:fast-decompression?
- %prefer-fast-decompression?)))
- (unless print-build-trace?
- (format (current-error-port)
- (G_ "Downloading ~a...~%") (uri->string uri)))
-
- (let* ((raw download-size
- ;; 'guix publish' without '--cache' doesn't specify a
- ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
- (fetch uri))
+ (define (try-fetch choices)
+ (match choices
+ (((uri compression file-size) rest ...)
+ (guard (c ((and (pair? rest) (http-get-error? c))
+ (warning (G_ "download from '~a' failed, trying next URL~%")
+ (uri->string uri))
+ (try-fetch rest)))
+ (let ((port download-size (fetch uri)))
+ (unless print-build-trace?
+ (format (current-error-port)
+ (G_ "Downloading ~a...~%") (uri->string uri)))
+ (values port uri compression download-size))))
+ (()
+ (leave (G_ "no valid nar URLs for ~a at ~a~%")
+ (narinfo-path narinfo)
+ (narinfo-uri-base narinfo)))))
+
+ (let ((choices (narinfo-preferred-uris narinfo
+ #:fast-decompression?
+ %prefer-fast-decompression?)))
+ ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so
+ ;; DOWNLOAD-SIZE is #f in this case.
+ (let* ((raw uri compression download-size (try-fetch choices))
(progress
(let* ((dl-size (or download-size
(and (equal? compression "none")