ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

ftp-client: Fix off-by-one when trying addresses in 'ftp-open'.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

47
guix/ftp-client.scm
View file

@ -139,31 +139,32 @@ (define addresses
AI_ADDRCONFIG)))
(let loop ((addresses addresses))
(let* ((ai (car addresses))
(s (socket (addrinfo:fam ai)
;; TCP/IP only
SOCK_STREAM IPPROTO_IP)))
(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)))))
(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))))))))
(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)))