substitute: Gracefully handle TLS termination while fetching narinfos.

Fixes <https://issues.guix.gnu.org/62476>.

* guix/substitutes.scm (call-with-connection-error-handling): Add
'gnutls-error case.
This commit is contained in:
Ludovic Courtès 2023-03-27 10:55:31 +02:00
parent 3b9738aeac
commit af91c2d540
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
@ -35,6 +35,7 @@ (define-module (guix substitutes)
#:select ((open-connection-for-uri #:select ((open-connection-for-uri
. guix:open-connection-for-uri) . guix:open-connection-for-uri)
resolve-uri-reference)) resolve-uri-reference))
#:autoload (gnutls) (error->string error/premature-termination)
#:use-module (guix progress) #:use-module (guix progress)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -152,6 +153,13 @@ (define host
(strerror (strerror
(system-error-errno `(system-error ,@args))))) (system-error-errno `(system-error ,@args)))))
#f) #f)
(('gnutls-error error proc . rest)
(if (eq? error error/premature-termination)
(begin
(warning (G_ "~a: TLS connection failed: in ~a: ~a~%") host
proc (error->string error))
#f)
(apply throw 'gnutls-error error proc rest)))
(args (args
(apply throw args))))) (apply throw args)))))