download: Pass the timeout to 'ftp-retr'.

This ensures the timeout applies when connecting to the port returned by
PASV.

* guix/ftp-client.scm (ftp-list): Add #:timeout parameter.  Use
'connect*' instead of 'connect' and pass TIMEOUT.
(ftp-retr): Likewise.
* guix/build/download.scm (ftp-fetch): Pass TIMEOUT to 'ftp-retr'.
This commit is contained in:
Ludovic Courtès 2017-11-14 09:51:50 +01:00
parent 5724a14e71
commit 9f8605958e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 8 additions and 6 deletions

View File

@ -130,7 +130,8 @@ out if the connection could not be established in less than TIMEOUT seconds."
(_ (ftp-open (uri-host uri) #:timeout timeout)))) (_ (ftp-open (uri-host uri) #:timeout timeout))))
(size (false-if-exception (ftp-size conn (uri-path uri)))) (size (false-if-exception (ftp-size conn (uri-path uri))))
(in (ftp-retr conn (basename (uri-path uri)) (in (ftp-retr conn (basename (uri-path uri))
(dirname (uri-path uri))))) (dirname (uri-path uri))
#:timeout timeout)))
(call-with-output-file file (call-with-output-file file
(lambda (out) (lambda (out)
(dump-port* in out (dump-port* in out

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -228,7 +228,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
(sockaddr:scopeid sa))) (sockaddr:scopeid sa)))
(else #f)))) (else #f))))
(define* (ftp-list conn #:optional directory) (define* (ftp-list conn #:optional directory #:key timeout)
(if directory (if directory
(ftp-chdir conn directory)) (ftp-chdir conn directory))
@ -236,7 +236,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
(ai (ftp-connection-addrinfo conn)) (ai (ftp-connection-addrinfo conn))
(s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (s (socket (addrinfo:fam ai) (addrinfo:socktype ai)
(addrinfo:protocol ai)))) (addrinfo:protocol ai))))
(connect s (address-with-port (addrinfo:addr ai) port)) (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
(setvbuf s _IOLBF) (setvbuf s _IOLBF)
(dynamic-wind (dynamic-wind
@ -270,7 +270,8 @@ TIMEOUT, an ETIMEDOUT error is raised."
(or (eqv? code 226) (or (eqv? code 226)
(throw 'ftp-error conn "LIST" code message))))))) (throw 'ftp-error conn "LIST" code message)))))))
(define* (ftp-retr conn file #:optional directory) (define* (ftp-retr conn file #:optional directory
#:key timeout)
"Retrieve FILE from DIRECTORY (or, if omitted, the current directory) from "Retrieve FILE from DIRECTORY (or, if omitted, the current directory) from
FTP connection CONN. Return a binary port to that file. The returned port FTP connection CONN. Return a binary port to that file. The returned port
must be closed before CONN can be used for other purposes." must be closed before CONN can be used for other purposes."
@ -291,7 +292,7 @@ must be closed before CONN can be used for other purposes."
(or (eqv? code 226) (or (eqv? code 226)
(throw 'ftp-error conn "LIST" code message)))) (throw 'ftp-error conn "LIST" code message))))
(connect s (address-with-port (addrinfo:addr ai) port)) (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
(setvbuf s _IOLBF) (setvbuf s _IOLBF)
(%ftp-command (string-append "RETR " file) (%ftp-command (string-append "RETR " file)