summaryrefslogtreecommitdiff
path: root/guix/gnu-maintenance.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/gnu-maintenance.scm')
-rw-r--r--guix/gnu-maintenance.scm44
1 files changed, 12 insertions, 32 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index d63d44f629..ef067704ad 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -62,7 +62,6 @@
%gnu-updater
%gnu-ftp-updater
- %kde-updater
%xorg-updater
%kernel.org-updater))
@@ -230,12 +229,6 @@ network to check in GNU's database."
(or (assoc-ref (package-properties package) 'ftp-directory)
(string-append "/gnu/" name)))))
-(define (sans-extension tarball)
- "Return TARBALL without its .tar.* or .zip extension."
- (let ((end (or (string-contains tarball ".tar")
- (string-contains tarball ".zip"))))
- (substring tarball 0 end)))
-
(define %tarball-rx
;; The .zip extensions is notably used for freefont-ttf.
;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz".
@@ -261,14 +254,15 @@ true."
(string-append project
"-src")))))))
(not (regexp-exec %alpha-tarball-rx file))
- (let ((s (sans-extension file)))
+ (let ((s (tarball-sans-extension file)))
(regexp-exec %package-name-rx s))))
(define (tarball->version tarball)
"Return the version TARBALL corresponds to. TARBALL is a file name like
\"coreutils-8.23.tar.xz\"."
(let-values (((name version)
- (gnu-package-name->name+version (sans-extension tarball))))
+ (gnu-package-name->name+version
+ (tarball-sans-extension tarball))))
version))
(define* (releases project
@@ -492,8 +486,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
(and (string=? url (basename url)) ;relative reference?
(release-file? package url)
(let-values (((name version)
- (package-name->name+version (sans-extension url)
- #\-)))
+ (package-name->name+version
+ (tarball-sans-extension url)
+ #\-)))
(upstream-source
(package name)
(version version)
@@ -565,14 +560,16 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
(release-file? name (basename file))))
files)))
(match (sort relevant (lambda (file1 file2)
- (version>? (sans-extension (basename file1))
- (sans-extension (basename file2)))))
+ (version>? (tarball-sans-extension
+ (basename file1))
+ (tarball-sans-extension
+ (basename file2)))))
((and tarballs (reference _ ...))
(let* ((version (tarball->version reference))
(tarballs (filter (lambda (file)
- (string=? (sans-extension
+ (string=? (tarball-sans-extension
(basename file))
- (sans-extension
+ (tarball-sans-extension
(basename reference))))
tarballs)))
(upstream-source
@@ -615,16 +612,6 @@ releases are on gnu.org."
(define gnu-hosted?
(url-prefix-predicate "mirror://gnu/"))
-(define (latest-kde-release package)
- "Return the latest release of PACKAGE, the name of an KDE.org package."
- (let ((uri (string->uri (origin-uri (package-source package)))))
- (false-if-ftp-error
- (latest-ftp-release
- (package-upstream-name package)
- #:server "ftp.mirrorservice.org"
- #:directory (string-append "/sites/ftp.kde.org/pub/kde/"
- (dirname (dirname (uri-path uri))))))))
-
(define (latest-xorg-release package)
"Return the latest release of PACKAGE, the name of an X.org package."
(let ((uri (string->uri (origin-uri (package-source package)))))
@@ -672,13 +659,6 @@ releases are on gnu.org."
(pure-gnu-package? package))))
(latest latest-release*)))
-(define %kde-updater
- (upstream-updater
- (name 'kde)
- (description "Updater for KDE packages")
- (pred (url-prefix-predicate "mirror://kde/"))
- (latest latest-kde-release)))
-
(define %xorg-updater
(upstream-updater
(name 'xorg)