diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-11-22 14:16:36 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-11-22 14:16:36 +0100 |
commit | d6d33984df8df4f061eadaac1d71119c97c0db9f (patch) | |
tree | 6adc52ff96e4f25afa1781cfbd24c6976ed6d7c6 | |
parent | 5fb95cc5925cab6f1105158d6092d8051b58a23e (diff) | |
download | guix-d6d33984df8df4f061eadaac1d71119c97c0db9f.tar.gz |
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))'.)
-rw-r--r-- | guix/ftp-client.scm | 51 |
1 files changed, 26 insertions, 25 deletions
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index e76f08afd4..a6a54a4d9c 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -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))) |