From 87dfd45594e6e1f6d4ab790412b4fe0a607f30cd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 27 Apr 2013 16:25:54 +0200
Subject: ftp-client: `ftp-chdir' changes one step at a time.

* guix/ftp-client.scm (%char-set:not-slash): New variable.
  (ftp-chdir): Add docstring.  Change to DIR one step at a time.
  (ftp-retr): Fix indentation.
---
 guix/ftp-client.scm | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

(limited to 'guix/ftp-client.scm')

diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index e3bacc3720..ba3201fdab 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -130,9 +130,22 @@ or a TCP port number), and return it."
 (define (ftp-close conn)
   (close (ftp-connection-socket conn)))
 
+(define %char-set:not-slash
+  (char-set-complement (char-set #\/)))
+
 (define (ftp-chdir conn dir)
-  (%ftp-command (string-append "CWD " dir) 250
-                (ftp-connection-socket conn)))
+  "Change to directory DIR."
+
+  ;; On ftp.gnupg.org, "PASV" right after "CWD /gcrypt/gnupg" hangs.  Doing
+  ;; CWD in two steps works, so just do this.
+  (let ((components (string-tokenize dir %char-set:not-slash)))
+    (fold (lambda (dir result)
+            (%ftp-command (string-append "CWD " dir) 250
+                          (ftp-connection-socket conn)))
+          #f
+          (if (string-prefix? "/" dir)
+              (cons "/" components)
+              components))))
 
 (define (ftp-size conn file)
   "Return the size in bytes of FILE."
@@ -238,15 +251,15 @@ must be closed before CONN can be used for other purposes."
                                    (rec (read! bv start count)
                                         (match (get-bytevector-n! s bv
                                                                   start count)
-                                       ((? eof-object?) 0)
-                                       (0
-                                        ;; Nothing available yet, so try
-                                        ;; again.  This is important because
-                                        ;; the return value of `read!' makes
-                                        ;; it impossible to distinguish
-                                        ;; between "not yet" and "EOF".
-                                        (read! bv start count))
-                                       (read read)))
+                                          ((? eof-object?) 0)
+                                          (0
+                                           ;; Nothing available yet, so try
+                                           ;; again.  This is important because
+                                           ;; the return value of `read!' makes
+                                           ;; it impossible to distinguish
+                                           ;; between "not yet" and "EOF".
+                                           (read! bv start count))
+                                          (read read)))
                                    #f #f          ; no get/set position
                                    terminate)))
 
-- 
cgit v1.2.3