~ruther/guix-local

d6d33984df8df4f061eadaac1d71119c97c0db9f — Ludovic Courtès 10 years ago 5fb95cc 
ftp-client: Fix off-by-one when trying addresses in 'ftp-open'.

* guix/ftp-client.scm (ftp-open): Change to use 'match' instead of
car/cdr, and fix off-by-one (was '(null? addresses)' instead of
'(null? (cdr addresses))'.)
patch browse .tar.gz 
1 files changed, 26 insertions(+), 25 deletions(-)

M guix/ftp-client.scm

M guix/ftp-client.scm => guix/ftp-client.scm +26 -25
@@ 139,31 139,32 @@ TIMEOUT, an ETIMEDOUT error is raised."
                     AI_ADDRCONFIG)))

  (let loop ((addresses addresses))
    (let* ((ai (car addresses))
           (s  (socket (addrinfo:fam ai)
                       ;; TCP/IP only
                       SOCK_STREAM IPPROTO_IP)))

      (catch 'system-error
        (lambda ()
          (connect* s (addrinfo:addr ai) timeout)
          (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
                  (close s)
                  (throw 'ftp-error s "log-in" code message)))))

        (lambda args
          ;; Connection failed, so try one of the other addresses.
          (close s)
          (if (null? addresses)
              (apply throw args)
              (loop (cdr addresses))))))))
    (match addresses
      ((ai rest ...)
       (let ((s (socket (addrinfo:fam ai)
                        ;; TCP/IP only
                        SOCK_STREAM IPPROTO_IP)))

         (catch 'system-error
           (lambda ()
             (connect* s (addrinfo:addr ai) timeout)
             (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
                     (close s)
                     (throw 'ftp-error s "log-in" code message)))))

           (lambda args
             ;; Connection failed, so try one of the other addresses.
             (close s)
             (if (null? rest)
                 (apply throw args)
                 (loop rest)))))))))

(define (ftp-close conn)
  (close (ftp-connection-socket conn)))