aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-03-13 12:45:13 +0100
committerLudovic Courtès <ludo@gnu.org>2021-03-17 12:03:24 +0100
commitdb69ebb9debda9e53ebb62f5113303cd9ff8dc14 (patch)
tree888ad41e45eb105c7c7b3d710eb4e0f3e78e7126
parent71f6acd28df098fa600861df49347a315ffc7bb5 (diff)
downloadguix-db69ebb9debda9e53ebb62f5113303cd9ff8dc14.tar.gz
guix-db69ebb9debda9e53ebb62f5113303cd9ff8dc14.zip
gnu-maintenance: 'latest-html-release' considers non-relative URLs.
* guix/gnu-maintenance.scm (latest-html-release): Allow for URL to be an arbitrary URL rather than a relative URL reference.
-rw-r--r--guix/gnu-maintenance.scm30
1 files changed, 16 insertions, 14 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index febed57c3a..98d326e500 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
@@ -479,19 +479,21 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(port (http-fetch/cached uri #:ttl 3600))
(sxml (html->sxml port)))
(define (url->release url)
- (and (string=? url (basename url)) ;relative reference?
- (release-file? package url)
- (let-values (((name version)
- (package-name->name+version
- (tarball-sans-extension url)
- #\-)))
- (upstream-source
- (package name)
- (version version)
- (urls (list (string-append base-url directory "/" url)))
- (signature-urls
- (list (file->signature
- (string-append base-url directory "/" url))))))))
+ (let* ((base (basename url))
+ (url (if (string=? base url)
+ (string-append base-url directory "/" url)
+ url)))
+ (and (release-file? package base)
+ (let-values (((name version)
+ (package-name->name+version
+ (tarball-sans-extension base)
+ #\-)))
+ (upstream-source
+ (package name)
+ (version version)
+ (urls (list url))
+ (signature-urls
+ (list (file->signature url))))))))
(define candidates
(filter-map url->release (html-links sxml)))