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))'.)
This commit is contained in:
Ludovic Courtès 2015-11-22 14:16:36 +01:00
parent 5fb95cc592
commit d6d33984df
1 changed files with 24 additions and 23 deletions

View File

@ -139,31 +139,32 @@ TIMEOUT, an ETIMEDOUT error is raised."
AI_ADDRCONFIG))) AI_ADDRCONFIG)))
(let loop ((addresses addresses)) (let loop ((addresses addresses))
(let* ((ai (car addresses)) (match addresses
(s (socket (addrinfo:fam ai) ((ai rest ...)
;; TCP/IP only (let ((s (socket (addrinfo:fam ai)
SOCK_STREAM IPPROTO_IP))) ;; TCP/IP only
SOCK_STREAM IPPROTO_IP)))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect* s (addrinfo:addr ai) timeout) (connect* s (addrinfo:addr ai) timeout)
(setvbuf s _IOLBF) (setvbuf s _IOLBF)
(let-values (((code message) (%ftp-listen s))) (let-values (((code message) (%ftp-listen s)))
(if (eqv? code 220) (if (eqv? code 220)
(begin (begin
;;(%ftp-command "OPTS UTF8 ON" 200 s) ;;(%ftp-command "OPTS UTF8 ON" 200 s)
(%ftp-login "anonymous" "guix@example.com" s) (%ftp-login "anonymous" "guix@example.com" s)
(%make-ftp-connection s ai)) (%make-ftp-connection s ai))
(begin (begin
(close s) (close s)
(throw 'ftp-error s "log-in" code message))))) (throw 'ftp-error s "log-in" code message)))))
(lambda args (lambda args
;; Connection failed, so try one of the other addresses. ;; Connection failed, so try one of the other addresses.
(close s) (close s)
(if (null? addresses) (if (null? rest)
(apply throw args) (apply throw args)
(loop (cdr addresses)))))))) (loop rest)))))))))
(define (ftp-close conn) (define (ftp-close conn)
(close (ftp-connection-socket conn))) (close (ftp-connection-socket conn)))