colin/nixpkgs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

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

svn path=/nixpkgs/trunk/; revision=21715
This commit is contained in:
Ludovic Courtès 2010-05-10 21:26:48 +00:00
parent d8c33c1820
commit 5dd1036a04
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
maintainers/scripts/gnu/gnupdate.scm
View File

@ -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)))
(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))))))
;; 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~%"