aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-07-20 20:36:53 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-20 23:25:09 +0200
commit7a6bb2fe5b69ca6d3fdd118c4d211cef94df6ddc (patch)
tree3c61ef43e5767872be50850dd8d6aca20c099688
parentcffaf285c19ea5f0465c7ad2196b7a478ef21873 (diff)
downloadguix-7a6bb2fe5b69ca6d3fdd118c4d211cef94df6ddc.tar.gz
guix-7a6bb2fe5b69ca6d3fdd118c4d211cef94df6ddc.zip
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.
-rw-r--r--guix/gnu-maintenance.scm28
1 files changed, 27 insertions, 1 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index a1273ab461..702848ed95 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -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)