gnu-maintenance: Handle lists returned by 'origin-uri'.

[jackhill/guix/guix.git] / guix / ftp-client.scm

diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 22d4c7d..8d5adcb 100644 (file)
--- 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,7 +22,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-31)
-  #:use-module (rnrs io ports)
+  #:use-module (ice-9 binary-ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -121,7 +121,10 @@ seconds to wait for the connection to succeed."
              (raise-error errno)))))
       (connect s sockaddr)))
 
-(define* (ftp-open host #:optional (port "ftp") #:key timeout)
+(define* (ftp-open host #:optional (port "ftp")
+                        #:key timeout
+                              (username "anonymous")
+                              (password "guix@example.com"))
   "Open an FTP connection to HOST on PORT (a service-identifying string,
 or a TCP port number), and return it.
 
@@ -151,12 +154,12 @@ TIMEOUT, an ETIMEDOUT error is raised."
          (catch 'system-error
            (lambda ()
              (connect* s (addrinfo:addr ai) timeout)
-             (setvbuf s _IOLBF)
+             (setvbuf s 'line)
              (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)
+                     (%ftp-login username password s)
                      (%make-ftp-connection s ai))
                    (begin
                      (close s)
@@ -225,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))
 
@@ -233,8 +236,8 @@ 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))
-    (setvbuf s _IOLBF)
+    (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
+    (setvbuf s 'line)
 
     (dynamic-wind
       (lambda () #t)
@@ -267,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."
@@ -288,8 +292,8 @@ 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))
-    (setvbuf s _IOLBF)
+    (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
+    (setvbuf s 'line)
 
     (%ftp-command (string-append "RETR " file)
                   150 (ftp-connection-socket conn))