aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-22 14:16:36 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-22 14:16:36 +0100
commitd6d33984df8df4f061eadaac1d71119c97c0db9f (patch)
tree6adc52ff96e4f25afa1781cfbd24c6976ed6d7c6
parent5fb95cc5925cab6f1105158d6092d8051b58a23e (diff)
downloadgnu-guix-d6d33984df8df4f061eadaac1d71119c97c0db9f.tar
gnu-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.scm51
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)))