net/ftp: ftp-current-directory

* implement ftp-current-directory
* add test for ftp-current-directory

pkgs/net-lib/net/ftp.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require racket/date racket/file racket/port racket/tcp racket/list)
+(require racket/date racket/file racket/port racket/tcp racket/list racket/string)
 
 (provide ftp-connection?
          ftp-cd
@@ -13,7 +13,8 @@
          ftp-delete-file
          ftp-make-directory
          ftp-delete-directory
-         ftp-rename-file)
+         ftp-rename-file
+         ftp-current-directory)
 
 ;; opqaue record to represent an FTP connection:
 (define-struct ftp-connection (in out))
@@ -168,6 +169,15 @@
                       (ftp-connection-out ftp-ports)
                       #"250" void (void)))
 
+(define (ftp-current-directory ftp-ports)
+  (fprintf (ftp-connection-out ftp-ports) "PWD\r\n")
+  (ftp-check-response (ftp-connection-in ftp-ports)
+                      (ftp-connection-out ftp-ports)
+                      #"257"
+                      (lambda (line acc)
+                        (cadr (string-split (bytes->string/latin-1 line) "\"")))
+                      (void)))
+
 (define re:dir-line
   (regexp (string-append
            "^(.)(.*) ((?i:jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)"

pkgs/net-test/tests/net/ftp.rkt

@@ -53,6 +53,7 @@
         (when (ftp-connection? conn)
           (define output (open-output-bytes))
           (test (ftp-cd conn "gnu")
+                (ftp-current-directory conn) => "/gnu"
                 (for ([f (in-list (ftp-directory-list conn))])
                   (match-define (list* type ftp-date name ?size) f)
                   (test (ftp-make-file-seconds ftp-date)))
@@ -239,6 +240,7 @@
      250-system. See:
      250-http://www.gnu.org/philosophy/categories.html#TheGNUsystem
      250 Directory successfully changed.
+     257 "/gnu" is the current directory
      227 Entering Passive Mode (127,0,0,1,@pasv1-port)
      200 Switching to Binary mode.
      150 Here comes the directory listing.
@@ -263,6 +265,7 @@
   @(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){
      USER anonymous
      CWD gnu
+     PWD
      PASV
      TYPE I
      LIST