mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 21:46:35 +01:00
gnu-maintenance: ‘import-html-release’ doesn’t abort upon HTTP 404.
Previously, updaters using ‘import-html-release’ would throw to 'quit when the HTML page isn’t found, aborting the whole process: $ guix refresh coreutils libchop guix refresh: error: https://de.freedif.org/savannah//libchop/: HTTP download failed: 404 ("Not Found") * guix/gnu-maintenance.scm (url->links): Guard against ‘http-get-error?’ and return the empty list when it is raised. Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com> Change-Id: I419ff96ddb424aa8c74d6bab3d66a5e85355c3dc
This commit is contained in:
parent
8ee03e30bd
commit
2c5f6787fd
1 changed files with 12 additions and 6 deletions
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2010-2023 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2010-2024 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>
|
||||
|
@ -30,6 +30,7 @@ (define-module (guix gnu-maintenance)
|
|||
#:use-module (srfi srfi-2)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module ((guix http-client) #:hide (open-socket-for-uri))
|
||||
;; not required in many cases, so autoloaded to reduce start-up costs.
|
||||
|
@ -496,11 +497,16 @@ (define (html-links sxml)
|
|||
|
||||
(define (url->links url)
|
||||
"Return the unique links on the HTML page accessible at URL."
|
||||
(let* ((uri (string->uri url))
|
||||
(port (http-fetch/cached uri #:ttl 3600))
|
||||
(sxml (html->sxml port)))
|
||||
(close-port port)
|
||||
(delete-duplicates (html-links sxml))))
|
||||
(guard (c ((http-get-error? c)
|
||||
(warning (G_ "failed to download '~a': ~a (~a)~%")
|
||||
url (http-get-error-code c)
|
||||
(http-get-error-reason c))
|
||||
'()))
|
||||
(let* ((uri (string->uri url))
|
||||
(port (http-fetch/cached uri #:ttl 3600))
|
||||
(sxml (html->sxml port)))
|
||||
(close-port port)
|
||||
(delete-duplicates (html-links sxml)))))
|
||||
|
||||
(define (canonicalize-url url base-url)
|
||||
"Make relative URL absolute, by appending URL to BASE-URL as required. If
|
||||
|
|
Loading…
Reference in a new issue