summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-01-03 14:24:26 +0100
committerLudovic Courtès <ludo@gnu.org>2023-01-08 16:11:45 +0100
commitf3edf29c67b50de888ff23c771b4cbe3e8142656 (patch)
tree76ccb8de6853fb6dbf02890a20607c01072aa250 /guix/import
parent3012dad9eb1acc64574d68cd29212be6ad96281e (diff)
gnu-maintenance: Factorize 'false-if-networking-failure'.
* guix/import/utils.scm (call-with-networking-exception-handler): New procedure. (false-if-networking-error): New macro. * guix/gnu-maintenance.scm (import-html-updatable-release): Use it instead of inline code.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/utils.scm24
1 files changed, 23 insertions, 1 deletions
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 41311cb86e..72795d2c61 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2018, 2019, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017, 2019, 2020, 2022 Ricardo Wurmus <rekado@elephly.net>
@@ -54,10 +54,12 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-71)
#:export (factorize-uri
flatten
+ false-if-networking-error
url-fetch
guix-hash-url
@@ -122,6 +124,26 @@ of the string VERSION is replaced by the symbol 'version."
(cons elem memo)))
'() lst))
+(define (call-with-networking-exception-handler thunk)
+ "Invoke THUNK, returning #f if one of the usual networking exception is
+thrown."
+ (catch #t
+ (lambda ()
+ (guard (c ((http-get-error? c) #f))
+ (thunk)))
+ (lambda (key . args)
+ ;; Return false and move on upon connection failures and bogus HTTP
+ ;; servers.
+ (unless (memq key '(gnutls-error tls-certificate-error
+ system-error getaddrinfo-error
+ bad-header bad-header-component))
+ (apply throw key args))
+ #f)))
+
+(define-syntax-rule (false-if-networking-error exp)
+ "Evaluate EXP, returning #f if a networking-related exception is thrown."
+ (call-with-networking-exception-handler (lambda () exp)))
+
(define (url-fetch url file-name)
"Save the contents of URL to FILE-NAME. Return #f on failure."
(parameterize ((current-output-port (current-error-port)))