Hi! These patches add a ‘sourceforge’ updater. Initially I tried implementing it in terms of ‘latest-html-release’ but that doesn’t work because of the peculiar URL scheme that SF uses, with “/download” appended to otherwise nice-looking URLs. Instead, this one looks at the /latest URL supported by SourceForge. It’s less efficient than ‘generic-html’ for instance because there’s no caching and there’s up to three additional HEAD requests performed to find if there are detached signatures. The last patch has ‘guix lint -c refresh’ emit warnings when a package lacks an updater or when its updater doesn’t work. This should help us find out which updaters need to be improved or implemented. Feedback welcome! Ludo’. Ludovic Courtès (3): gnu-maintenance: Add 'sourceforge' updater. upstream: 'package-latest-release' tries all the matching updaters. lint: refresh: Warn about missing or dysfunctional updaters. doc/guix.texi | 2 ++ guix/gnu-maintenance.scm | 55 ++++++++++++++++++++++++++++++++++++++++ guix/lint.scm | 41 +++++++++++++++++++----------- guix/upstream.scm | 15 ++++++----- 4 files changed, 92 insertions(+), 21 deletions(-) -- 2.31.1
This updater currently covers 2.4% of the packages. * guix/gnu-maintenance.scm (latest-sourceforge-release): New procedure. (%sourceforge-updater): New variable. * doc/guix.texi (Invoking guix refresh): Document it. --- doc/guix.texi | 2 ++ guix/gnu-maintenance.scm | 55 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index bada446357..d9ab8090a0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11713,6 +11713,8 @@ list of updaters). Currently, @var{updater} may be one of: the updater for GNU packages; @item savannah the updater for packages hosted at @uref{https://savannah.gnu.org, Savannah}; +@item sourceforge +the updater for packages hosted at @uref{https://sourceforge.net, SourceForge}; @item gnome the updater for GNOME packages; @item kde diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index c7972d13a5..79214ae1a0 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -66,6 +66,7 @@ %gnu-updater %gnu-ftp-updater %savannah-updater + %sourceforge-updater %xorg-updater %kernel.org-updater %generic-html-updater)) @@ -660,6 +661,53 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." #:directory directory) (cut adjusted-upstream-source <> rewrite)))) +(define (latest-sourceforge-release package) + "Return the latest release of PACKAGE." + (define (uri-append uri extension) + ;; Return URI with EXTENSION appended. + (build-uri (uri-scheme uri) + #:host (uri-host uri) + #:path (string-append (uri-path uri) extension))) + + (define (valid-uri? uri) + ;; Return true if URI is reachable. + (catch #t + (lambda () + (case (response-code (http-head uri)) + ((200 302) #t) + (else #f))) + (const #f))) + + (let* ((name (package-upstream-name package)) + (base (string-append "https://sourceforge.net/projects/" + name "/files")) + (url (string-append base "/latest/download")) + (response (catch #t (lambda () (http-head url)) + (const #f)))) + (and response + (= 302 (response-code response)) + (response-location response) + (match (string-tokenize (uri-path (response-location response)) + (char-set-complement (char-set #\/))) + ((_ components ...) + (let* ((path (string-join components "/")) + (url (string-append "mirror://sourceforge/" path))) + (and (release-file? name (basename path)) + + ;; Take the heavy-handed approach of probing 3 additional + ;; URLs. XXX: Would be nicer if this could be avoided. + (let* ((loc (response-location response)) + (sig (any (lambda (extension) + (let ((uri (uri-append loc extension))) + (and (valid-uri? uri) + (string-append url extension)))) + '(".asc" ".sig" ".sign")))) + (upstream-source + (package name) + (version (tarball->version (basename path))) + (urls (list url)) + (signature-urls (and sig (list sig)))))))))))) + (define (latest-xorg-release package) "Return the latest release of PACKAGE." (let ((uri (string->uri (origin-uri (package-source package))))) @@ -774,6 +822,13 @@ the directory containing its source tarball." (pred (url-prefix-predicate "mirror://savannah/")) (latest latest-savannah-release))) +(define %sourceforge-updater + (upstream-updater + (name 'sourceforge) + (description "Updater for packages hosted on sourceforge.net") + (pred (url-prefix-predicate "mirror://sourceforge/")) + (latest latest-sourceforge-release))) + (define %xorg-updater (upstream-updater (name 'xorg) -- 2.31.1
* guix/upstream.scm (package-latest-release): Try UPDATERS until one of them returns an upstream source. This is useful for packages with several matching updaters, such a zlib ('sourceforge' and 'generic-html'). --- guix/upstream.scm | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/guix/upstream.scm b/guix/upstream.scm index accd8967d8..632e9ebc4f 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -264,12 +264,15 @@ them matches." #:optional (updaters (force %updaters))) "Return an upstream source to update PACKAGE, a <package> object, or #f if -none of UPDATERS matches PACKAGE. It is the caller's responsibility to ensure -that the returned source is newer than the current one." - (match (lookup-updater package updaters) - ((? upstream-updater? updater) - ((upstream-updater-latest updater) package)) - (_ #f))) +none of UPDATERS matches PACKAGE. When several updaters match PACKAGE, try +them until one of them returns an upstream source. It is the caller's +responsibility to ensure that the returned source is newer than the current +one." + (any (match-lambda + (($ <upstream-updater> name description pred latest) + (and (pred package) + (latest package)))) + updaters)) (define* (package-latest-release* package #:optional -- 2.31.1
This feedback should help us improve updaters. * guix/lint.scm (check-for-updates): Return a warning when PACKAGE lacks an updater or when the updater returns #f. --- guix/lint.scm | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index cdd9dd14d7..a7d6bbba4f 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1191,21 +1191,32 @@ vulnerability records for PACKAGE by calling PACKAGE-VULNERABILITIES." (define (check-for-updates package) "Check if there is an update available for PACKAGE." - (match (with-networking-fail-safe - (format #f (G_ "while retrieving upstream info for '~a'") - (package-name package)) - #f - (package-latest-release* package)) - ((? upstream-source? source) - (if (version>? (upstream-source-version source) - (package-version package)) - (list - (make-warning package - (G_ "can be upgraded to ~a") - (list (upstream-source-version source)) - #:field 'version)) - '())) - (#f '()))) ; cannot find newer upstream release + (match (lookup-updater package) + (#f + (list (make-warning package (G_ "no updater for ~a") + (list (package-name package)) + #:field 'source))) + ((? upstream-updater? updater) + (match (with-networking-fail-safe + (format #f (G_ "while retrieving upstream info for '~a'") + (package-name package)) + #f + (package-latest-release package)) + ((? upstream-source? source) + (if (version>? (upstream-source-version source) + (package-version package)) + (list + (make-warning package + (G_ "can be upgraded to ~a") + (list (upstream-source-version source)) + #:field 'version)) + '())) + (#f ;cannot find upstream release + (list (make-warning package + (G_ "updater '~a' failed to find \ +upstream releases") + (list (upstream-updater-name updater)) + #:field 'source))))))) (define (check-archival package) -- 2.31.1
Hey Ludo, > + (catch #t > + (lambda () > + (case (response-code (http-head uri)) > + ((200 302) #t) > + (else #f))) > + (const #f))) Any reason not to use "false-if-exception" here ... > + (response (catch #t (lambda () (http-head url)) > + (const #f)))) ... and here? Otherwise, I tested the whole patchset, seems fine :). Thanks, Mathieu
[-- Attachment #1: Type: text/plain, Size: 207 bytes --] Thanks a lot Ludo for this! Sourceforge updater was wondering why it didnt exist maybe not possible but you did it! Also linter to check if updaters are working correctly, really awesome idea! Léo [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 833 bytes --]
Hi Mathieu, Mathieu Othacehe <othacehe@gnu.org> skribis: >> + (catch #t >> + (lambda () >> + (case (response-code (http-head uri)) >> + ((200 302) #t) >> + (else #f))) >> + (const #f))) > > Any reason not to use "false-if-exception" here ... > >> + (response (catch #t (lambda () (http-head url)) >> + (const #f)))) > > ... and here? No good reason, not sure what was on my mind. I’ll adjust accordingly. > Otherwise, I tested the whole patchset, seems fine :). Cool, thank you! Ludo’.
Pushed as 709f30b8e466b5f7155255be4f2cee008f8d01a9 with changes as Mathieu suggested. Thanks for your feedback! Ludo’.