diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-06-02 21:50:07 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-06-02 21:55:30 +0200 |
| commit | d7bc3470b76268fb121868960aab04c88a4d712f (patch) | |
| tree | 095340f42f3ac3d2f3361b231cb0b9d0582e1e96 /guix | |
| parent | ed8a724b331869bf79a441a8c2243d2c4468101d (diff) | |
| download | gnu-guix-d7bc3470b76268fb121868960aab04c88a4d712f.tar gnu-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'.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/gnu-maintenance.scm | 61 |
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 |