From d6d33984df8df4f061eadaac1d71119c97c0db9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 22 Nov 2015 14:16:36 +0100 Subject: 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))'.) --- guix/ftp-client.scm | 51 ++++++++++++++++++++++++++------------------------- 1 file changed, 26 insertions(+), 25 deletions(-) (limited to 'guix/ftp-client.scm') 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))) -- cgit v1.2.3