diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-01-03 14:24:26 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-01-08 16:11:45 +0100 |
| commit | f3edf29c67b50de888ff23c771b4cbe3e8142656 (patch) | |
| tree | 76ccb8de6853fb6dbf02890a20607c01072aa250 /guix/import | |
| parent | 3012dad9eb1acc64574d68cd29212be6ad96281e (diff) | |
| download | guix-patches-f3edf29c67b50de888ff23c771b4cbe3e8142656.tar guix-patches-f3edf29c67b50de888ff23c771b4cbe3e8142656.tar.gz | |
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.scm | 24 |
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))) |