~ruther/guix-local

885d524f79aa4bbfac5dfebf285e1e248184ee70 — Ludovic Courtès 3 years ago 3f5e141
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.
2 files changed, 34 insertions(+), 2 deletions(-)

M guix/scripts/substitute.scm
M tests/substitute.scm
M guix/scripts/substitute.scm => guix/scripts/substitute.scm +10 -1
@@ 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?)))

M tests/substitute.scm => tests/substitute.scm +24 -1
@@ 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*