gnupdate: Add optional directory argument to `ftp-list'.

* maintainers/scripts/gnu/gnupdate.scm (ftp-list): Add optional
  DIRECTORY argument.
  (releases): Pass DIRECTORY to `ftp-list'.

svn path=/nixpkgs/trunk/; revision=21715

1 files changed, 18 insertions, 16 deletions

diff --git a/maintainers/scripts/gnu/gnupdate.scm b/maintainers/scripts/gnu/gnupdate.scm
index 1401f5b94e360..4df48f931feae 100644
--- a/maintainers/scripts/gnu/gnupdate.scm
+++ b/maintainers/scripts/gnu/gnupdate.scm
@@ -360,7 +360,7 @@
            (throw 'ftp-error conn "PASV" 227 message)))))
 
 
-(define (ftp-list conn)
+(define* (ftp-list conn #:optional directory)
   (define (address-with-port sa port)
     (let ((fam  (sockaddr:fam sa))
           (addr (sockaddr:addr sa)))
@@ -372,6 +372,9 @@
                                   (sockaddr:scopeid sa)))
             (else #f))))
 
+  (if directory
+      (ftp-chdir conn directory))
+
   (let* ((port (ftp-pasv conn))
          (ai   (ftp-connection-addrinfo conn))
          (s    (socket (addrinfo:fam ai) (addrinfo:socktype ai)
@@ -514,21 +517,20 @@
   (catch #t
     (lambda ()
       (let-values (((server directory) (ftp-server/directory project)))
-        (let ((conn (ftp-open server)))
-          (ftp-chdir conn directory)
-          (let ((files (ftp-list conn)))
-            (ftp-close conn)
-            (map (lambda (tarball)
-                   (let ((end (string-contains tarball ".tar")))
-                     (substring tarball 0 end)))
-
-                 ;; Filter out signatures, deltas, and files which are potentially
-                 ;; not releases of PROJECT (e.g., in /gnu/guile, filter out
-                 ;; guile-oops and guile-www).
-                 (filter (lambda (file)
-                           (and (not (string-suffix? ".sig" file))
-                                (regexp-exec release-rx file)))
-                         files))))))
+        (let* ((conn  (ftp-open server))
+               (files (ftp-list conn directory)))
+          (ftp-close conn)
+          (map (lambda (tarball)
+                 (let ((end (string-contains tarball ".tar")))
+                   (substring tarball 0 end)))
+
+               ;; Filter out signatures, deltas, and files which are potentially
+               ;; not releases of PROJECT (e.g., in /gnu/guile, filter out
+               ;; guile-oops and guile-www).
+               (filter (lambda (file)
+                         (and (not (string-suffix? ".sig" file))
+                              (regexp-exec release-rx file)))
+                       files)))))
     (lambda (key subr message . args)
       (format (current-error-port)
               "failed to get release list for `~A': ~A ~A~%"