me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2023-05-22 17:19:39 +02:00
parent d23d8fcee9
commit 8af9a2aa5f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 70 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/narinfo.scm
View File

@ -54,6 +54,7 @@
narinfo-hash-algorithm+value
narinfo-hash->sha256
narinfo-preferred-uris
narinfo-best-uri
valid-narinfo?
@ -309,9 +310,11 @@ than 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 @@ compression ratio (typically lzip)."
((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))))

33
guix/scripts/substitute.scm
View File

@ -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)))
(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* ((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")

36
tests/substitute.scm
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*