[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
12/72: gnu-maintenance: Allow mirror URLs to fallback to the generic HTM
From: |
guix-commits |
Subject: |
12/72: gnu-maintenance: Allow mirror URLs to fallback to the generic HTML updater. |
Date: |
Tue, 15 Aug 2023 20:42:23 -0400 (EDT) |
apteryx pushed a commit to branch qt-updates
in repository guix.
commit 4f3cd2f7afc562f9e0b93f87daf4aeadd0c7954e
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Fri Aug 11 11:21:42 2023 -0400
gnu-maintenance: Allow mirror URLs to fallback to the generic HTML updater.
* guix/gnu-maintenance.scm (http-url?): Extract from
html-updatable-package?,
modify to return the HTTP URL, and support the mirror:// scheme.
(%disallowed-hosting-sites): New variable, extracted from
html-updatable-package.
(html-updatable-package?): Rewrite a mirror:// URL to an HTTP or HTTPS one.
* guix/download.scm (%mirrors): Update comment.
Series-changes: 2
- Update %mirrors comment to mention speed-related exceptions
---
guix/download.scm | 5 ++++-
guix/gnu-maintenance.scm | 58 ++++++++++++++++++++++++++++++------------------
2 files changed, 41 insertions(+), 22 deletions(-)
diff --git a/guix/download.scm b/guix/download.scm
index ce6ebd0df8..31a41e8183 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -51,7 +51,10 @@
;;; Code:
(define %mirrors
- ;; Mirror lists used when `mirror://' URLs are passed.
+ ;; Mirror lists used when `mirror://' URLs are passed. The first mirror
+ ;; entry of each set should ideally be the most authoritative one, as that's
+ ;; what the generic HTML updater will pick to look for updates, with
+ ;; possible exceptions when the authoritative mirror is too slow.
(let* ((gnu-mirrors
'(;; This one redirects to a (supposedly) nearby and (supposedly)
;; up-to-date mirror.
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 3cd84ee3d7..2574e0f827 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -928,27 +928,40 @@ Optionally include a VERSION string to fetch a specific
version."
#:directory directory
#:file->signature file->signature)))
-(define html-updatable-package?
- ;; Return true if the given package may be handled by the generic HTML
- ;; updater.
- (let ((hosting-sites '("github.com" "github.io" "gitlab.com"
- "notabug.org" "sr.ht" "gitlab.inria.fr"
- "ftp.gnu.org" "download.savannah.gnu.org"
- "pypi.org" "crates.io" "rubygems.org"
- "bioconductor.org")))
- (define http-url?
- (url-predicate (lambda (url)
- (match (string->uri url)
- (#f #f)
- (uri
- (let ((scheme (uri-scheme uri))
- (host (uri-host uri)))
- (and (memq scheme '(http https))
- (not (member host hosting-sites)))))))))
-
- (lambda (package)
- (or (assoc-ref (package-properties package) 'release-monitoring-url)
- (http-url? package)))))
+;;; These sites are disallowed for the generic HTML updater as there are
+;;; better means to query them.
+(define %disallowed-hosting-sites
+ '("github.com" "github.io" "gitlab.com"
+ "notabug.org" "sr.ht" "gitlab.inria.fr"
+ "ftp.gnu.org" "download.savannah.gnu.org"
+ "pypi.org" "crates.io" "rubygems.org"
+ "bioconductor.org"))
+
+(define (http-url? url)
+ "Return URL if URL has HTTP or HTTPS as its protocol. If URL uses the
+special mirror:// protocol, substitute it with the first HTTP or HTTPS URL
+prefix from its set."
+ (match (string->uri url)
+ (#f #f)
+ (uri
+ (let ((scheme (uri-scheme uri))
+ (host (uri-host uri)))
+ (or (and (memq scheme '(http https))
+ (not (member host %disallowed-hosting-sites))
+ url)
+ (and (eq? scheme 'mirror)
+ (and=> (find http-url?
+ (assoc-ref %mirrors
+ (string->symbol host)))
+ (lambda (url)
+ (string-append (strip-trailing-slash url)
+ (uri-path uri))))))))))
+
+(define (html-updatable-package? package)
+ "Return true if the given package may be handled by the generic HTML
+updater."
+ (or (assoc-ref (package-properties package) 'release-monitoring-url)
+ ((url-predicate http-url?) package)))
(define* (import-html-updatable-release package #:key (version #f))
"Return the latest release of PACKAGE. Do that by crawling the HTML page of
@@ -956,6 +969,9 @@ the directory containing its source tarball. Optionally
include a VERSION
string to fetch a specific version."
(let* ((uri (string->uri
(match (origin-uri (package-source package))
+ ((? (cut string-prefix? "mirror://" <>) url)
+ ;; Retrieve the authoritative HTTP URL from a mirror.
+ (http-url? url))
((? string? url) url)
((url _ ...) url))))
(custom (assoc-ref (package-properties package)
- 19/72: gnu: qt5compat: Update to 6.5.2., (continued)
- 19/72: gnu: qt5compat: Update to 6.5.2., guix-commits, 2023/08/15
- 38/72: gnu: Remove qtquickcontrols2., guix-commits, 2023/08/15
- 58/72: gnu: qtwebview: Update to 5.15.10., guix-commits, 2023/08/15
- 59/72: gnu: qtlocation: Update to 5.15.10., guix-commits, 2023/08/15
- 52/72: gnu: qtmultimedia-5: Shorten maximum line width., guix-commits, 2023/08/15
- 22/72: gnu: qtimageformats-5: Fix indentation., guix-commits, 2023/08/15
- 10/72: gnu-maintenance: Extract 'canonicalize-url' from 'import-html-release'., guix-commits, 2023/08/15
- 14/72: gnu: qt: Revert to use individual versions instead of %qt5-version., guix-commits, 2023/08/15
- 17/72: gnu: qtbase: Update to 6.5.2., guix-commits, 2023/08/15
- 20/72: gnu: qtsvg: Update to 6.5.2., guix-commits, 2023/08/15
- 12/72: gnu-maintenance: Allow mirror URLs to fallback to the generic HTML updater.,
guix-commits <=
- 16/72: etc: Add Qt manifests for Qt maintenance., guix-commits, 2023/08/15
- 21/72: gnu: qtimageformats: Rename variable to qtimageformats-5., guix-commits, 2023/08/15
- 23/72: gnu: Add qtimageformats., guix-commits, 2023/08/15
- 29/72: gnu: qtwayland: Update to 6.5.2., guix-commits, 2023/08/15
- 33/72: gnu: qttranslations: Update to 6.5.2., guix-commits, 2023/08/15
- 39/72: gnu: qt-creator: Update to 11.0.1., guix-commits, 2023/08/15
- 62/72: gnu: qtquickcontrols-5: Update to 5.15.10., guix-commits, 2023/08/15
- 65/72: gnu: qtgamepad: Update to 5.15.10., guix-commits, 2023/08/15
- 61/72: gnu: qtscript: Update to 5.15.10., guix-commits, 2023/08/15
- 53/72: gnu: qtwayland-5: Update to 5.15.10., guix-commits, 2023/08/15