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'.

1 files changed, 32 insertions, 16 deletions

diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 220419734f..a42d7956da 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -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))