diff options
Diffstat (limited to 'guix/gnu-maintenance.scm')
| -rw-r--r-- | guix/gnu-maintenance.scm | 44 |
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) |