Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Mon, 22 May 2023 15:32:01 UTC
Severity: important
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ludovic Courtès <ludo <at> gnu.org> To: 63646 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <mail <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Ricardo Wurmus <rekado <at> elephly.net>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr> Subject: [bug#63646] [PATCH] substitute: If a server's nar URL is 404, try the next one(s). Date: Mon, 22 May 2023 17:30:50 +0200
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.
---
guix/narinfo.scm | 21 +++++++++++++++++----
guix/scripts/substitute.scm | 33 ++++++++++++++++++++++-----------
tests/substitute.scm | 36 +++++++++++++++++++++++++++++++-----
3 files changed, 70 insertions(+), 20 deletions(-)
diff --git a/guix/narinfo.scm b/guix/narinfo.scm
index 741c7ad406..a149d9a901 100644
--- a/guix/narinfo.scm
+++ b/guix/narinfo.scm
@@ -54,6 +54,7 @@ (define-module (guix narinfo)
narinfo-hash-algorithm+value
narinfo-hash->sha256
+ narinfo-preferred-uris
narinfo-best-uri
valid-narinfo?
@@ -309,9 +310,11 @@ (define (decompresses-faster? compression1 compression2)
("gzip" (string=? compression2 "lzip"))
(_ #f)))
-(define* (narinfo-best-uri narinfo #:key fast-decompression?)
- "Select the \"best\" URI to download NARINFO's nar, and return three values:
-the URI, its compression method (a string), and the compressed file size.
+(define* (narinfo-preferred-uris narinfo #:key fast-decompression?)
+ "Return the sorted list of \"preferred\" nar URIs from NARINFO (preferred
+comes first) where each entry is a tuple containing: the URI, its compression
+method (a string), and the compressed file size.
+
When FAST-DECOMPRESSION? is true, prefer substitutes with faster
decompression (typically zstd) rather than substitutes with a higher
compression ratio (typically lzip)."
@@ -343,6 +346,16 @@ (define* (narinfo-best-uri narinfo #:key fast-decompression?)
((uri2 compression2 . _)
(decompresses-faster? compression2 compression1))))))
- (match (sort choices (if fast-decompression? (negate speed<?) file-size<?))
+ (sort choices (if fast-decompression? (negate speed<?) file-size<?)))
+
+(define* (narinfo-best-uri narinfo #:key fast-decompression?)
+ "Select the \"best\" URI to download NARINFO's nar, and return three values:
+the URI, its compression method (a string), and the compressed file size.
+
+When FAST-DECOMPRESSION? is true, prefer substitutes with faster
+decompression (typically zstd) rather than substitutes with a higher
+compression ratio (typically lzip)."
+ (match (narinfo-preferred-uris narinfo
+ #:fast-decompression? fast-decompression?)
(((uri compression file-size) _ ...)
(values uri compression file-size))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0b27ebb0fc..7a612c971c 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -481,18 +481,29 @@ (define* (download-nar narinfo destination
(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)))
+ (define (try-fetch choices)
+ (match choices
+ (((uri compression file-size) rest ...)
+ (guard (c ((and (pair? rest) (network-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* ((raw download-size
- ;; 'guix publish' without '--cache' doesn't specify a
- ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
- (fetch uri))
+ (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")
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 @@ (define-syntax-rule (test-quit name error-rx exp)
(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 @@ (define-syntax-rule (with-narinfo* narinfo directory body ...)
(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*
base-commit: dff1689bb37e5303868584d3f1d7a33cbcb7f51e
--
2.40.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.