me
/
guix
Archived
1
0
Fork 0
Code

ftp-client: Try all the addresses returned by `getaddrinfo'. 

* guix/ftp-client.scm (ftp-open): Upon connection failure, try the other
  addresses returned by `getaddrinfo'.
master
Ludovic Courtès 2012-10-13 21:18:16 +02:00
parent 568717fd90
commit 4004f95379
1 changed files with 32 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
guix/ftp-client.scm
View File

@ -81,24 +81,40 @@
(else (throw 'ftp-error port command code message))))))
(define (ftp-open host)
"Open an FTP connection to HOST, and return it."
(catch 'getaddrinfo-error
(lambda ()
(let* ((ai (car (getaddrinfo host "ftp")))
(s (socket (addrinfo:fam ai) (addrinfo:socktype ai)
(addrinfo:protocol ai))))
(connect s (addrinfo:addr ai))
(setvbuf s _IOLBF)
(let-values (((code message) (%ftp-listen s)))
(if (eqv? code 220)
(begin
;(%ftp-command "OPTS UTF8 ON" 200 s)
(%ftp-login "anonymous" "ludo@example.com" s)
(%make-ftp-connection s ai))
(begin
(format (current-error-port) "FTP to `~a' failed: ~A: ~A~%"
host code message)
(close s)
#f)))))
(define addresses
(getaddrinfo host "ftp"))
(let loop ((addresses addresses))
(let* ((ai (car addresses))
(s (socket (addrinfo:fam ai) (addrinfo:socktype ai)
(addrinfo:protocol ai))))
(catch 'system-error
(lambda ()
(connect s (addrinfo:addr ai))
(setvbuf s _IOLBF)
(let-values (((code message) (%ftp-listen s)))
(if (eqv? code 220)
(begin
;;(%ftp-command "OPTS UTF8 ON" 200 s)
(%ftp-login "anonymous" "guix@example.com" s)
(%make-ftp-connection s ai))
(begin
(format (current-error-port)
"FTP to `~a' failed: ~A: ~A~%"
host code message)
(close s)
#f))))
(lambda args
;; Connection failed, so try one of the other addresses.
(close s)
(if (null? addresses)
(apply throw args)
(loop (cdr addresses))))))))
(lambda (key errcode)
(format (current-error-port) "failed to resolve `~a': ~a~%"
host (gai-strerror errcode))