01/02: download: Pass the timeout to 'ftp-retr'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 9f8605958ef86a0054a04297917ca32ed58d9d56
Author: Ludovic Courtès <address@hidden>
Date:   Tue Nov 14 09:51:50 2017 +0100

    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'.
---
 guix/build/download.scm |  3 ++-
 guix/ftp-client.scm     | 11 ++++++-----
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index a65c7b9..90de269 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -130,7 +130,8 @@ out if the connection could not be established in less than 
TIMEOUT seconds."
                  (_ (ftp-open (uri-host uri) #:timeout timeout))))
          (size (false-if-exception (ftp-size conn (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
       (lambda (out)
         (dump-port* in out
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 054a00a..0b8f61c 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès 
<address@hidden>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès 
<address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -228,7 +228,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
                                 (sockaddr:scopeid sa)))
           (else #f))))
 
-(define* (ftp-list conn #:optional directory)
+(define* (ftp-list conn #:optional directory #:key timeout)
   (if directory
       (ftp-chdir conn directory))
 
@@ -236,7 +236,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
          (ai   (ftp-connection-addrinfo conn))
          (s    (socket (addrinfo:fam ai) (addrinfo:socktype 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)
 
     (dynamic-wind
@@ -270,7 +270,8 @@ TIMEOUT, an ETIMEDOUT error is raised."
           (or (eqv? code 226)
               (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
 FTP connection CONN.  Return a binary port to that file.  The returned port
 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)
             (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)
 
     (%ftp-command (string-append "RETR " file)