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/gnu-maintenance.scm | |
| parent | 3012dad9eb1acc64574d68cd29212be6ad96281e (diff) | |
| download | guix-f3edf29c67b50de888ff23c771b4cbe3e8142656.tar guix-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/gnu-maintenance.scm')
| -rw-r--r-- | guix/gnu-maintenance.scm | 23 |
1 files changed, 7 insertions, 16 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 8e60e52ea0..0418c297f2 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> @@ -43,6 +43,7 @@ #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) + #:autoload (guix import utils) (false-if-networking-error) #:autoload (zlib) (call-with-gzip-input-port) #:autoload (htmlprag) (html->sxml) ;from Guile-Lib #:export (gnu-package-name @@ -871,21 +872,11 @@ string to fetch a specific version." "" (dirname (uri-path uri)))) (package (package-upstream-name package))) - (catch #t - (lambda () - (guard (c ((http-get-error? c) #f)) - (import-html-release package - #:version version - #:base-url base - #:directory directory))) - (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)))) + (false-if-networking-error + (import-html-release package + #:version version + #:base-url base + #:directory directory)))) (define %gnu-updater ;; This is for everything at ftp.gnu.org. |