~ruther/guix-local

4004f95379acf963529c8693452b78164de8febe — Ludovic Courtès 13 years ago 568717f
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(-)

M guix/ftp-client.scm
M guix/ftp-client.scm => guix/ftp-client.scm +32 -16
@@ 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))