diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-03-13 12:45:13 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-03-17 12:03:24 +0100 |
| commit | db69ebb9debda9e53ebb62f5113303cd9ff8dc14 (patch) | |
| tree | 888ad41e45eb105c7c7b3d710eb4e0f3e78e7126 | |
| parent | 71f6acd28df098fa600861df49347a315ffc7bb5 (diff) | |
| download | guix-db69ebb9debda9e53ebb62f5113303cd9ff8dc14.tar.gz | |
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.scm | 30 |
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))) |