me
/
guix
Archived
1
0
Fork 0
Code

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
Ludovic Courtès 2023-06-08 22:43:05 +02:00
parent 3f5e141829
commit 885d524f79
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 34 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
guix/scripts/substitute.scm
View File

@ -38,7 +38,7 @@
#:use-module (guix cache) #:use-module (guix cache)
#:use-module (gcrypt pk-crypto) #:use-module (gcrypt pk-crypto)
#:use-module (guix pki) #: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) #:use-module ((guix build download)
#:select (uri-abbreviation nar-uri-abbreviation #:select (uri-abbreviation nar-uri-abbreviation
(open-connection-for-uri (open-connection-for-uri
@ -445,6 +445,11 @@ server certificates."
"Bind PORT with EXP... to a socket connected to URI." "Bind PORT with EXP... to a socket connected to URI."
(call-with-cached-connection uri (lambda (port) exp ...))) (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 (define* (download-nar narinfo destination
#:key status-port #:key status-port
deduplicate? print-build-trace?) deduplicate? print-build-trace?)
@ -503,6 +508,10 @@ STATUS-PORT."
(narinfo-path narinfo) (narinfo-path narinfo)
(narinfo-uri-base 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 (let ((choices (narinfo-preferred-uris narinfo
#:fast-decompression? #:fast-decompression?
%prefer-fast-decompression?))) %prefer-fast-decompression?)))

25
tests/substitute.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -639,6 +639,29 @@ System: mips64el-linux\n")))
(lambda () (lambda ()
(false-if-exception (delete-file "substitute-retrieved"))))))) (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" (test-quit "substitute, narinfo is available but nar is missing"
"failed to find alternative substitute" "failed to find alternative substitute"
(with-narinfo* (with-narinfo*