From 5dd1036a04140af37507b19f126e8ed8f64a64a7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 May 2010 21:26:48 +0000 Subject: 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 --- maintainers/scripts/gnu/gnupdate.scm | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) (limited to 'maintainers') 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~%" -- cgit 1.4.1