aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-02 21:50:07 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-02 21:55:30 +0200
commitd7bc3470b76268fb121868960aab04c88a4d712f (patch)
tree095340f42f3ac3d2f3361b231cb0b9d0582e1e96
parented8a724b331869bf79a441a8c2243d2c4468101d (diff)
downloadguix-d7bc3470b76268fb121868960aab04c88a4d712f.tar
guix-d7bc3470b76268fb121868960aab04c88a4d712f.tar.gz
gnu-maintenance: latest-release: Honor releases that are not in subdirs.
Reported by Mark H Weaver. * guix/gnu-maintenance.scm (latest-release): Add 'result' parameter to 'loop'. When entering a sub-directory, use the current directory's latest release as 'result'. This fixes the code for 'gnu-pw-mgr' and 'sharutils'.
-rw-r--r--guix/gnu-maintenance.scm61
1 files changed, 34 insertions, 27 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 5cdda28bc7..8d47cee487 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -357,7 +357,8 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(let-values (((server directory) (ftp-server/directory project)))
(define conn (ftp-open server))
- (let loop ((directory directory))
+ (let loop ((directory directory)
+ (result #f))
(let* ((entries (ftp-list conn directory))
;; Filter out sub-directories that do not contain digits---e.g.,
@@ -369,32 +370,38 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(((? contains-digit? dir) 'directory . _)
dir)
(_ #f))
- entries)))
- (match subdirs
- (()
- ;; No sub-directories, so assume that tarballs are here.
- (let ((releases (filter-map (match-lambda
- ((file 'file . _)
- (and (release-file? project file)
- (gnu-release
- (package project)
- (version
- (tarball->version file))
- (directory directory)
- (files (list file)))))
- (_ #f))
- entries)))
- (ftp-close conn)
- (reduce latest-release #f (coalesce-releases releases))))
- ((subdirs ...)
- ;; Assume that SUBDIRS correspond to versions, and jump into the
- ;; one with the highest version number.
- (let ((target (reduce latest #f subdirs)))
- (if target
- (loop (string-append directory "/" target))
- (begin
- (ftp-close conn)
- #f)))))))))
+ entries))
+
+ ;; Whether or not SUBDIRS is empty, compute the latest releases
+ ;; for the current directory. This is necessary for packages
+ ;; such as 'sharutils' that have a sub-directory that contains
+ ;; only an older release.
+ (releases (filter-map (match-lambda
+ ((file 'file . _)
+ (and (release-file? project file)
+ (gnu-release
+ (package project)
+ (version
+ (tarball->version file))
+ (directory directory)
+ (files (list file)))))
+ (_ #f))
+ entries)))
+
+ ;; Assume that SUBDIRS correspond to versions, and jump into the
+ ;; one with the highest version number.
+ (let* ((release (reduce latest-release #f
+ (coalesce-releases releases)))
+ (result (if (and result release)
+ (latest-release release result)
+ (or release result)))
+ (target (reduce latest #f subdirs)))
+ (if target
+ (loop (string-append directory "/" target)
+ result)
+ (begin
+ (ftp-close conn)
+ result)))))))
(define (gnu-release-archive-types release)
"Return the available types of archives for RELEASE---a list of strings such