From: "Ludovic Courtès" <ludo@gnu.org>
To: 47126@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#47126] [PATCH 4/7] gnu-maintenance: 'latest-html-release' can determine signature file name.
Date: Sat, 13 Mar 2021 22:46:17 +0100 [thread overview]
Message-ID: <20210313214620.28186-4-ludo@gnu.org> (raw)
In-Reply-To: <20210313214620.28186-1-ludo@gnu.org>
* guix/gnu-maintenance.scm (latest-html-release): #:file->signature
defaults to #f.
[file->signature/guess]: New procedure.
[url->release]: Use it when FILE->SIGNATURE is #f.
Introduce 'links' variable.
(url-prefix-rewrite): Check whether URL is true before calling
'string-prefix?'.
(latest-savannah-release): Adjust comment about detached signatures.
---
guix/gnu-maintenance.scm | 36 ++++++++++++++++++++++++------------
1 file changed, 24 insertions(+), 12 deletions(-)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index a8b24fa336..3bffa4d11e 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -470,16 +470,29 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
#:key
(base-url "https://kernel.org/pub")
(directory (string-append "/" package))
- (file->signature (cut string-append <> ".sig")))
+ file->signature)
"Return an <upstream-source> for the latest release of PACKAGE (a string) on
SERVER under DIRECTORY, or #f. BASE-URL should be the URL of an HTML page,
typically a directory listing as found on 'https://kernel.org/pub'.
-FILE->SIGNATURE must be a procedure; it is passed a source file URL and must
-return the corresponding signature URL, or #f it signatures are unavailable."
- (let* ((uri (string->uri (string-append base-url directory "/")))
- (port (http-fetch/cached uri #:ttl 3600))
- (sxml (html->sxml port)))
+When FILE->SIGNATURE is omitted or #f, guess the detached signature file name,
+if any. Otherwise, FILE->SIGNATURE must be a procedure; it is passed a source
+file URL and must return the corresponding signature URL, or #f it signatures
+are unavailable."
+ (let* ((uri (string->uri (string-append base-url directory "/")))
+ (port (http-fetch/cached uri #:ttl 3600))
+ (sxml (html->sxml port))
+ (links (delete-duplicates (html-links sxml))))
+ (define (file->signature/guess url)
+ (let ((base (basename url)))
+ (any (lambda (link)
+ (any (lambda (extension)
+ (and (string=? (string-append base extension)
+ (basename link))
+ (string-append url extension)))
+ '(".asc" ".sig" ".sign")))
+ links)))
+
(define (url->release url)
(let* ((base (basename url))
(url (if (string=? base url)
@@ -495,10 +508,10 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(version version)
(urls (list url))
(signature-urls
- (list (file->signature url))))))))
+ (list ((or file->signature file->signature/guess) url))))))))
(define candidates
- (filter-map url->release (html-links sxml)))
+ (filter-map url->release links))
(close-port port)
(match candidates
@@ -614,7 +627,7 @@ releases are on gnu.org."
(define (url-prefix-rewrite old new)
"Return a one-argument procedure that rewrites URL prefix OLD to NEW."
(lambda (url)
- (if (string-prefix? old url)
+ (if (and url (string-prefix? old url))
(string-append new (string-drop url (string-length old)))
url)))
@@ -646,9 +659,8 @@ releases are on gnu.org."
(directory (dirname (uri-path uri)))
(rewrite (url-prefix-rewrite %savannah-base
"mirror://savannah")))
- ;; Note: We use the default 'file->signature', which adds ".sig", but not
- ;; all projects on Savannah follow that convention: some use ".asc" and
- ;; perhaps some lack signatures altogether.
+ ;; Note: We use the default 'file->signature', which adds ".sig", ".asc",
+ ;; or whichever detached signature naming scheme PACKAGE uses.
(and=> (latest-html-release package
#:base-url %savannah-base
#:directory directory)
--
2.30.1
next prev parent reply other threads:[~2021-03-13 21:47 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-13 21:43 [bug#47126] [PATCH 0/7] Add 'generic-html' updater Ludovic Courtès
2021-03-13 21:46 ` [bug#47126] [PATCH 1/7] gnu-maintenance: Use (htmlprag) for 'latest-html-release' Ludovic Courtès
2021-03-13 21:46 ` [bug#47126] [PATCH 2/7] gnu-maintenance: 'latest-html-release' considers non-relative URLs Ludovic Courtès
2021-03-13 21:46 ` [bug#47126] [PATCH 3/7] gnu-maintenance: 'release-file?' rejects checksum files Ludovic Courtès
2021-03-13 21:46 ` Ludovic Courtès [this message]
2021-03-13 21:46 ` [bug#47126] [PATCH 5/7] gnu-maintenance: 'latest-html-release' better computes version number Ludovic Courtès
2021-03-13 21:46 ` [bug#47126] [PATCH 6/7] gnu-maintenance: Add 'generic-html' updater Ludovic Courtès
2021-03-13 21:46 ` [bug#47126] [PATCH 7/7] gnu: hwloc: Add 'release-monitoring-url' property Ludovic Courtès
2021-03-17 10:18 ` [bug#47126] [PATCH 0/7] Add 'generic-html' updater Léo Le Bouter via Guix-patches via
2021-03-17 13:52 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210313214620.28186-4-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=47126@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).