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'.
This commit is contained in:
Ludovic Courtès 2015-06-02 21:50:07 +02:00
parent ed8a724b33
commit d7bc3470b7
1 changed files with 34 additions and 27 deletions

View File

@ -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