gnu-maintenance: Add 'savannah' updater.

* guix/gnu-maintenance.scm (savannah-package?, %savannah-base)
(%savannah-updater): New variables.
(latest-savannah-release): New procedure.
(latest-xorg-release): Fix docstring.
This commit is contained in:
Ludovic Courtès 2020-07-20 20:36:53 +02:00
parent cffaf285c1
commit 7a6bb2fe5b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 27 additions and 1 deletions

View File

@ -62,6 +62,7 @@
%gnu-updater
%gnu-ftp-updater
%savannah-updater
%xorg-updater
%kernel.org-updater))
@ -614,8 +615,26 @@ releases are on gnu.org."
(define gnu-hosted?
(url-prefix-predicate "mirror://gnu/"))
(define savannah-package?
(url-prefix-predicate "mirror://savannah/"))
(define %savannah-base
;; One of the Savannah mirrors listed at
;; <http://download0.savannah.gnu.org/mirmon/savannah/> that serves valid
;; HTML (unlike <https://download.savannah.nongnu.org/releases>.)
"https://nongnu.freemirror.org/nongnu")
(define (latest-savannah-release package)
"Return the latest release of PACKAGE."
(let* ((uri (string->uri (origin-uri (package-source package))))
(package (package-upstream-name package))
(directory (dirname (uri-path uri))))
(latest-html-release package
#:base-url %savannah-base
#:directory directory)))
(define (latest-xorg-release package)
"Return the latest release of PACKAGE, the name of an X.org package."
"Return the latest release of PACKAGE."
(let ((uri (string->uri (origin-uri (package-source package)))))
(false-if-ftp-error
(latest-ftp-release
@ -661,6 +680,13 @@ releases are on gnu.org."
(pure-gnu-package? package))))
(latest latest-release*)))
(define %savannah-updater
(upstream-updater
(name 'savannah)
(description "Updater for packages hosted on savannah.gnu.org")
(pred (url-prefix-predicate "mirror://savannah/"))
(latest latest-savannah-release)))
(define %xorg-updater
(upstream-updater
(name 'xorg)