substitute: Gracefully retry after failed partial downloads.
Fixes <https://issues.guix.gnu.org/63443>. Reported by Attila Lendvai <attila@lendvai.name>. * guix/scripts/substitute.scm (catch-system-error): New macro. (download-nar): Add call to 'delete-file-recursively'. * tests/substitute.scm ("substitute, previous partial download around"): New test.master
parent
3f5e141829
commit
885d524f79
|
@ -38,7 +38,7 @@
|
|||
#:use-module (guix cache)
|
||||
#:use-module (gcrypt pk-crypto)
|
||||
#:use-module (guix pki)
|
||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||
#:autoload (guix build utils) (mkdir-p delete-file-recursively)
|
||||
#:use-module ((guix build download)
|
||||
#:select (uri-abbreviation nar-uri-abbreviation
|
||||
(open-connection-for-uri
|
||||
|
@ -445,6 +445,11 @@ server certificates."
|
|||
"Bind PORT with EXP... to a socket connected to URI."
|
||||
(call-with-cached-connection uri (lambda (port) exp ...)))
|
||||
|
||||
(define-syntax-rule (catch-system-error exp)
|
||||
(catch 'system-error
|
||||
(lambda () exp)
|
||||
(const #f)))
|
||||
|
||||
(define* (download-nar narinfo destination
|
||||
#:key status-port
|
||||
deduplicate? print-build-trace?)
|
||||
|
@ -503,6 +508,10 @@ STATUS-PORT."
|
|||
(narinfo-path narinfo)
|
||||
(narinfo-uri-base narinfo)))))
|
||||
|
||||
;; Delete DESTINATION first--necessary when starting over after a failed
|
||||
;; download.
|
||||
(catch-system-error (delete-file-recursively destination))
|
||||
|
||||
(let ((choices (narinfo-preferred-uris narinfo
|
||||
#:fast-decompression?
|
||||
%prefer-fast-decompression?)))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
;;; Copyright © 2014-2015, 2017-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014-2015, 2017-2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -639,6 +639,29 @@ System: mips64el-linux\n")))
|
|||
(lambda ()
|
||||
(false-if-exception (delete-file "substitute-retrieved")))))))
|
||||
|
||||
(test-equal "substitute, previous partial download around"
|
||||
"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)))
|
||||
(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))))
|
||||
(mkdir-p "substitute-retrieved/a/b/c/d") ;add stale data
|
||||
(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*
|
||||
|
|
Reference in New Issue