From f3edf29c67b50de888ff23c771b4cbe3e8142656 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Jan 2023 14:24:26 +0100 Subject: 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. --- guix/import/utils.scm | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'guix/import/utils.scm') 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 +;;; Copyright © 2012, 2013, 2018, 2019, 2020, 2023 Ludovic Courtès ;;; Copyright © 2016 Jelle Licht ;;; Copyright © 2016 David Craven ;;; Copyright © 2017, 2019, 2020, 2022 Ricardo Wurmus @@ -54,10 +54,12 @@ (define-module (guix import utils) #: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 @@ (define (flatten lst) (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))) -- cgit v1.2.3