From 697ed851b89a9d5f6cb691dfa5a23fa6b1128d6b Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Thu, 16 Jan 2003 10:01:28 +0000
Subject: [PATCH] - fix handling of multi-line replies - redo
 FTP-MODIFICATION-TIME and FTP-PWD without regexps

---
 scheme/lib/ftp.scm | 53 ++++++++++++++++++++++++----------------------
 1 file changed, 28 insertions(+), 25 deletions(-)

diff --git a/scheme/lib/ftp.scm b/scheme/lib/ftp.scm
index c05c8d7..ea19f4a 100644
--- a/scheme/lib/ftp.scm
+++ b/scheme/lib/ftp.scm
@@ -164,9 +164,13 @@
 
 ;;: on success return the new directory as a string
 (define (ftp-pwd connection)
-  (let* ((reply (ftp-send-command connection "PWD")) ;  257
-         (match (string-match "[0-9][0-9][0-9] \"(.*)\" " (or reply ""))))
-    (match:substring match 1)))
+  (let ((reply (ftp-send-command connection "PWD" (exactly-code "257"))))
+    (cond
+     ((regexp-search (rx (seq bos (= 3 digit) #\space
+			      (* (~ #\")) #\" (submatch (* (~ #\"))) #\"))
+		     reply)
+      => (lambda (match)
+	   (match:substring match 1))))))
 
 ;;: connection x string -> status
 (define (ftp-rmdir connection dir)
@@ -183,21 +187,19 @@
 (define (ftp-modification-time connection file)
   (let* ((reply (ftp-send-command connection
 				  (format #f "MDTM ~a" file)))
-         (match (string-match "[0-9][0-9][0-9] ([0-9]+)" (or reply "")))
-         (timestr (and match (match:substring match 1))))
-    (and timestr
-         (let ((year  (substring timestr 0 4))
-               (month (substring timestr 4 6))
-               (mday  (substring timestr 6 8))
-               (hour  (substring timestr 8 10))
-               (min   (substring timestr 10 12))
-               (sec   (substring timestr 12 14)))
-           (make-date (string->number sec)
-                      (string->number min)
-                      (string->number hour)
-                      (string->number mday)
-                      (string->number month)
-                      (- (string->number year) 1900))))))
+         (timestr (substring reply 4 (string-length reply))))
+    (let ((year  (substring timestr 0 4))
+	  (month (substring timestr 4 6))
+	  (mday  (substring timestr 6 8))
+	  (hour  (substring timestr 8 10))
+	  (min   (substring timestr 10 12))
+	  (sec   (substring timestr 12 14)))
+      (make-date (string->number sec)
+		 (string->number min)
+		 (string->number hour)
+		 (string->number mday)
+		 (string->number month)
+		 (- (string->number year) 1900)))))
 
 ;; On success return the size of the file in bytes.
 ;;: connection x string -> integer
@@ -431,13 +433,14 @@
 	  (signal 'ftp-error reply))
       ;; handle multi-line replies
       (if (char=? (string-ref reply 3) #\-)
-	  (let loop ()
-	    (let* ((line (read-crlf-line IN))
-		  (reply (string-join (list reply line "\n"))))
-	      (ftp-log connection (format #f "-> ~a" line))
-	      (if (string-prefix? code line)
-		  reply
-		  (loop code reply))))
+	  (let ((end-prefix (string-append code " ")))
+	    (let loop ()
+	      (let* ((line (read-crlf-line IN))
+		     (reply (string-join (list reply line "\n"))))
+		(ftp-log connection (format #f "-> ~a" line))
+		(if (string-prefix? end-prefix line)
+		    reply
+		    (loop)))))
 	  reply))))
 
 (define (ftp-build-command-string str . opt-args)